FindNext不会使用多个动态范围

时间:2017-02-22 17:54:45

标签: excel-vba find range offset vba

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

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

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

1 个答案:

答案 0 :(得分: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