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

您可以使用一个函数返回范围内的未合并值数组。

如果您可以依赖列相同，请执行以下操作：

遍历工作表的行，检查第8列（H）上每行的合并值。
测试每一行的.mergecells值是真还是假。
找到第一个合并的单元格值为true。
从该点开始查找下一个false值，将其记录为unmerge范围中的第一行。
找到下一个合并值，将上一行记录为最后一个未合并行。

你有第一个范围。如果你想为所有的值做这个，那么它将它们存储到数组中。

有点像这样：

（我对我的帖子中的草率代码感到内疚，所以我制作了一个应该更容易理解和实现的精简版本）

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

然后提供尽可能多的范围变量。

两个合并单元格VBA之间的单元格范围

3 个答案: