我正在嘗試創建一個 VBA 代碼，它可以讓我參考合并的標題并遍歷標題下的所有單元格。是否可以創建一個通過一系列相鄰合并單元格的 Do until 回圈？
例如，標題是從 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
這些是我想參考的單元格的標題 任何幫助將不勝感激！
uj5u.com熱心網友回復：
我不知道 using 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
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/377347.html