两个合并的单元格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

然后提供尽可能多的区域变量。