FindNext 不适用于多个动态范围

FindNext Won't Work With Multiple Dynamic Ranges

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

这是我开始使用的电子表格示例。一些常量是每个部分上方 B 列中的单词 "Material",第一个实例将始终位于单元格 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 开始,但这似乎也没有用。到目前为止,我只获得了用于查找 "Materials" 的第一个实例并在第一部分下方应用格式的代码。每个部分在单词 "Materials" 上方都有一个 Header,我也希望它位于小计行中。我想我可以用一个数组来做到这一点,但还没有那么远,如果我必须在这里和那里做一些手动输入,我完全可以接受!感谢您的帮助!

你能试试这个吗?我认为阴影范围不正确,但可以轻松纠正。

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