FindNext不会使用多个动态范围

Question

我尝试做的是在每个动态范围下添加一些单元格格式。我想我可以使用Find和FindNext，但我提出的代码仅适用于第一动态范围。我认为让我感到悲伤的问题是，我用Find / FindNext的常数是我的动态范围的顶部。然后我使用End(xlDown).Offset()来获取要格式化的单元格。

以下是我开始使用电子表格的示例。一些常量是＆＃34;材料＆＃34;在每个部分上方的B列中，第一个实例将始终位于单元格B13中，并且数据永远不会扩展到列H之外。每个部分中的行数将发生变化，并且部分的数量将发生变化。

这是运行宏后我想要的样子！

以下是我设法整理的代码。

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

我尝试了多种我在网上找到的变体，例如从For i = 12 to lRow开始Set cRange，但似乎也无效。到目前为止，我只获得了代码来找到＆＃34; Materials＆＃34;的第一个实例。并应用第1部分下面的格式。每个部分都有一个标题，高于＆＃34; Materials＆＃34;我也希望在Subtotal行中。我想我可以用一个阵列做到这一点，但还没到那么远，如果我必须在这里和那里做一些手动输入，我完全没问题！谢谢你的帮助！

Answer 1

你可以尝试一下吗？我不认为阴影范围是正确的，但可以很容易地纠正。

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