循环通过合并单元格下的相邻单元格

Question

我正在尝试创建一个 VBA 代码，它可以让我引用一个合并的标题并遍历标题下的所有单元格。是否可以创建一个遍历一系列相邻合并单元格的“直到循环”？

例如，标题是从 A1 到 C1 和 D1 到 G1 的合并单元格，我想创建一个循环来计算每个标题下来自不同来源的值。 目前，我有一个遍历特定列号的 for 循环，但我正在考虑将其更改为 Do Until 循环，因此当我添加一列并将其包含在标题中并重新运行宏时，它将包括所有列在标题下。

'Signals (Ped)
For a = 143 To 148
    For b = 4 To 203
    Worksheets("EACH ITEM CALCS").Cells(b, a).Value = _
        Application.CountIfs(Range(Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(9, 25), Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(5000, 25)), Worksheets("EACH ITEM CALCS").Cells(b, 1), _
        Range(Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(9, 46), Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(5000, 46)), Worksheets("EACH ITEM CALCS").Cells(3, a), _
        Range(Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(9, 44), Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(5000, 44)), "<>X")
Next b
Next a

'Ped Button
For b = 4 To 203
Worksheets("EACH ITEM CALCS").Cells(b, 149).Value = _
    Application.CountIfs(Range(Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(9, 25), Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(5000, 25)), Worksheets("EACH ITEM CALCS").Cells(b, 1), _
    Range(Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(9, 49), Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(5000, 49)), "<>-", _
    Range(Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(9, 48), Worksheets("SIGNAL POLE SCHED WORKSHEET").Cells(5000, 48)), "<>X")
Next b

These are the headers an cells that I want to reference 任何帮助将不胜感激！

Answer 1

我不知道如何使用Do Until，但如果您只需要在合并标题下找到已使用单元格的范围，您可以使用Range.MergeArea，它返回合并在一起的单元格集合给定范围。然后EntireColumn 获取该合并区域的完整列。然后你只需要将它修剪到非空白区域并切断标题所在的顶部。

这里是一个如何获得这个范围的例子。

Sub Example()
    Debug.Print UsedAreaUnderMergedHeader(Range("A1:C1")).Address
    Debug.Print UsedAreaUnderMergedHeader(Range("A1")).Address
    'My header is merged "A1:C1"
    'Both lines print the same output
    'Output is "$A$2:$C$28"
End Sub

Function UsedAreaUnderMergedHeader(Header As Range) As Range
    'Finding the Merged Area of the Header
    Dim MergedArea As Range
    Set MergedArea = Header.Cells(1).MergeArea
    
    'Finding the set of columns for that merged area
    Dim WholeColumns As Range
    Set WholeColumns = MergedArea.Columns.EntireColumn
    
    'Find the last row in the set of columns (check each column)
    Dim Column As Range, LastRow As Long
    For Each Column In WholeColumns.Columns
        Dim cLast As Long
        cLast = Column.Cells(Header.Parent.Rows.Count).End(xlUp).Row
        If cLast > LastRow Then LastRow = cLast
    Next
    
    'Build and return the range - The area under the merged header, up till the last row
    Set UsedAreaUnderMergedHeader = Header.Offset(MergedArea.Rows.Count).Resize(LastRow - MergedArea.Row - MergedArea.Rows.Count + 1, WholeColumns.Columns.Count)
End Function

然后你可以像这样循环遍历这个范围

Dim Cell As Range
For Each Cell In MyRange.Cells
   'do stuff
Next

或者你可以按行循环

Dim Row As Range
For Each Row in MyRange.Rows
   'do stuff
Next