FindNext 不适用于多个动态范围

Question

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

这是我开始使用电子表格的示例。一些常量是每个部分上方 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

我尝试了多种我在网上找到的变体，例如在Set cRange 上方以For i = 12 to lRow 开头，但这似乎也不起作用。到目前为止，我只获得了找到“材料”的第一个实例并在第一部分下方应用格式的代码。每个部分在“材料”一词上方都有一个标题，我也希望它出现在小计行中。我想我可以用一个数组来做到这一点，但还没有那么远，如果我必须在这里和那里做一些手动输入，我完全可以接受！感谢您的帮助！

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