兩個合並的單元格VBA之間的單元格范圍

Question

我將單元格D11到H11合並，將D20到H20合並，並將D25到H25合並。 我們將稱為合並行部分。 因此，D11到H11是部分1，D20到H20是部分2，依此類推。合並的部分之間的行數可以變化。

我正在嘗試創建一個VBA，可以創建各節之間單元格的垂直范圍。 因此，例如，第1部分和第2部分之間的垂直范圍為H12至H19，第2部分和第3部分之間的垂直范圍為H21至H24。

有任何想法嗎？

我目前正在嘗試創建一個包含1s和2s的數組（2s表示存在一個合並的單元格），然后計算1s來嘗試創建范圍。 我不知道這是否行得通，或者是否有更簡單的方法來做到這一點。

Sub newGroup()
Dim LastRow As Integer
Dim i As Long
Dim arr()     'This is an array definition
    i = 0
LastRow = Cells(Rows.Count, "H").End(xlUp).Row


For i = 12 To LastRow + 1
If Cells(i, 8).MergeCells = True Then

ReDim Preserve arr(1 To i)
arr(i) = 2
Else: arr(i) = 1

End If

Next


End Sub

Answer 1

您可以使用一個函數，該函數返回范圍內未合並值的數組。

如果可以依靠相同的列，則執行以下操作：

1. 遍歷工作表的行，檢查第8（H）列中每一行的合並值。
2. 測試每一行的.mergecells值是否為true或false。
3. 找到第一個合並的單元格值true。
4. 從這一點開始，找到下一個錯誤值，並將其記錄為取消合並范圍的第一行。
5. 找到下一個合並的值，將上一行記錄為最后一個未合並的行。

瞧，你有第一個范圍。 如果要對所有值執行此操作，請將其存儲到數組中。

有點像這樣：

（我對最初帖子中的草率代碼感到內gui，因此我制作了一個精簡版本，應該更易於理解和實現）

Sub Test()
    Dim v() As Variant
    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)           ' assign worksheet you want to scan

    v = Get_Unmerged_Ranges(8, ws)  ' Better version
End Sub

Function Get_Unmerged_Ranges(c As Integer, ws As Worksheet) As Variant
    Dim v() As Variant
    Dim r As Long

    ReDim v(1 To 1)

    With ws
        Do
            r = r + 1
            If .Cells(r, c).MergeCells Then
                If Not IsEmpty(v(1)) Then ReDim Preserve v(1 To UBound(v) + 1)
                i = UBound(v)
                If i Mod 2 = 1 Then
                    v(i) = r + 1 ' Odd entry is counted as start range which is 1 after the mergecells
                Else
                    v(i) = r - 1 ' Even entry is counted as end range which is the 1 before the mergecells
                    r = r - 1 ' Set the row back one to set the first variable on the next loop
                End If
            End If
        Loop Until r > .UsedRange.Rows.Count
    End With
    Get_Unmerged_Ranges = v
End Function

Answer 2

作為使用Range.Find方法的替代方法，它比逐個單元地循環要快得多。 它收集這些節並將其放入變量rngSections中。 然后，您可以使用rngSections.Areas屬性（代碼中顯示的示例）瀏覽它們

Sub tgr()

    Dim rngFound As Range
    Dim rngMerge As Range
    Dim rngSections As Range
    Dim SectionArea As Range
    Dim strFirst As String

    With Application.FindFormat
        .Clear
        .MergeCells = True
    End With

    Set rngFound = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchFormat:=True)
    If Not rngFound Is Nothing Then
        strFirst = rngFound.Address
        Set rngMerge = rngFound
        Do
            Set rngFound = Cells.Find("*", rngFound, SearchFormat:=True)
            If rngFound.Address = strFirst Then Exit Do
            If rngFound.Row - rngMerge.Row > 1 Then
                Select Case (rngSections Is Nothing)
                    Case True:  Set rngSections = Range(rngMerge.Offset(1), rngFound.Offset(-1))
                    Case Else:  Set rngSections = Union(rngSections, Range(rngMerge.Offset(1), rngFound.Offset(-1)))
                End Select
            End If
            Set rngMerge = rngFound
        Loop
    End If

    If Not rngSections Is Nothing Then
        'Whatever you want to do with the sections
        'For example, you could loop through them
        For Each SectionArea In rngSections.Areas
            MsgBox SectionArea.Address
        Next SectionArea
    End If

End Sub

Answer 3

您可能想嘗試循環瀏覽該列，並將每個新的非合並單元格添加到您的范圍中，例如：

Set r1 = Nothing
Do Until Cells(row, 8).MergeCells = True
    If r1 Is Nothing Then
        Set r1 = Range(Cells(row, 8), Cells(row, 8))
    Else
        Set r1 = Union(r1, Range(Cells(row, 8), Cells(row, 8)))
    End If
row = row + 1
Loop

然后提供盡可能多的區域變量。