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

Question

I am trying to create a VBA code that will let me refer to a header that is merged and go through all the cells that are under the header. 是否可以创建一个遍历一系列相邻合并单元格的“直到循环”？

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

'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

这些是我想引用的单元格的标题任何帮助将不胜感激！

Answer 1

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

这是一个如何获得此范围的示例。

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