FindNext不适用于多个动态范围

问题描述:

我想要做的是在每个动态范围下添加一些单元格格式。我想我可以使用FindFindNext,但我想出的代码只适用于第一个动态范围。我认为让我感到悲痛的问题是,我用于我的Find/FindNext的常量是我的动态范围的顶部。然后我使用End(xlDown).Offset()来到我想要格式化的单元格。FindNext不适用于多个动态范围

下面是我为电子表格开始的一个示例。其中一些常量是每个部分上方B列中的“材料”一词,第一个实例将始终在单元格B13中,并且数据永远不会扩展到H列之外。每个部分中的行数将更改,数字部分会改变。 before macro

这就是我希望它运行宏后的样子! after macro

这里是我设法将代码放在一起。

Option Explicit 
Sub findMaterials() 

Dim cRange As Range, cFound As Range 
Dim firstAddress As String 

Application.ScreenUpdating = False 

Set cRange = Cells.Find(What:="Materials", LookIn:=xlValues, _ 
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection _ 
      :=xlNext, MatchCase:=False, SearchFormat:=False) _ 
      .End(xlDown).Offset(1, 1) 
For Each cFound In cRange 
    If cFound = cRange Then 

    Do 

    firstAddress = cRange.Address 
    With Range(cRange, cRange.Offset(0, 5)) 
     .Interior.Color = RGB(149, 179, 215) 
     .Font.Color = vbWhite 
     .Font.Bold = True 
     .Font.Size = 11 
    End With 
    With Range(cRange, cRange.Offset(0, 4)) 
     .MergeCells = True 
     .HorizontalAlignment = xlRight 
    End With 

    Set cFound = Cells.FindNext(cFound.End(xlDown).Offset(1, 1)) 
    Loop While Not cFound Is Nothing And cRange.Address <> firstAddress 

    End If 

Next cFound 
End Sub 

我已经试过了,我在网上找到的,如与Set cRange高于For i = 12 to lRow开始,但似乎并没有擦出火花多种变化。到目前为止,我只获得了代码来查找“材质”的第一个实例并在第一部分下面应用格式。每个部分在“材料”一词上方都有一个标题,我希望它也在小计行中。我想我可以用一个数组来做到这一点,但还没有得到那么多,如果我必须在这里和那里做一些手动输入,我完全可以这么做!谢谢你的帮助!

你可以试试这个吗?我不认为阴影范围是正确的,但可以很容易地纠正。

Sub findMaterials() 

Dim cRange As Range, cFound As Range 
Dim firstAddress As String 

Set cRange = Columns(2).Find(What:="Materials", LookIn:=xlValues, _ 
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection _ 
      :=xlNext, MatchCase:=False, SearchFormat:=False) 
If Not cRange Is Nothing Then 
    firstAddress = cRange.Address 
    Do 
     Set cFound = cRange.End(xlDown).Offset(1, 5) 
     With cFound 
      .Interior.Color = RGB(149, 179, 215) 
      .Font.Color = vbWhite 
      .Font.Bold = True 
      .Font.Size = 11 
      .MergeCells = True 
      .HorizontalAlignment = xlRight 
     End With 
     Set cRange = Columns(2).FindNext(cRange) 
    Loop While cRange.Address <> firstAddress 
End If 

End Sub 
+0

非常感谢!一个小小的调整,它正是我希望它会做的!现在,我可以转向别的东西了!再次感谢! –