Question

我有一个例程，用于合并A列中的顺序单元格。我需要合并B列中顺序匹配的单元格，但不能跨合并的A列单元格的行边界进行合并。我对A列的合并按预期工作。

但是，如果列B中的值具有从合并的A单元格开始并继续到下一个单元格的顺序值，则它们将跨边界合并。如何将依序匹配的B细胞合并到已经合并的A细胞上？

这是我的代码当前如何合并A列的合并单元格的行边界：

Example

这就是我想要的样子：

Example of Successful Merge

我当前的代码：

Sub MergeV()
    ' Merge Administration and Category where sequentional matching rows exist

    ' Turn off screen updating
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim Current As Worksheet
    Dim lrow As Long

    For Each Current In ActiveWorkbook.Worksheets
        lrow = Cells(Rows.Count, 1).End(xlUp).Row
        Set rngMerge = Current.Range("A2:B" & lrow)

MergeAgain:
        For Each cell In rngMerge
            If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
                Range(cell, cell.Offset(1, 0)).Merge
                GoTo MergeAgain
            End If
        Next

    Next Current

    ' Turn screen updating back on
    Application.Calculation = xlCalculationAutomatic

End Sub

任何实现此目的的指导将不胜感激！

Answer 1

这很难解决。合并A列后，当合并顺序匹配B列中的单元格时，我可以检查A列中的相邻单元格是否合并 cell.Offset（0，-1）.MergeCell 。我还可以获取第一个合并的行 j = cell.Offset（0，-1）.MergeArea.Row ，并通过获取合并的行数 k = cell来计算最后一个合并的行。偏移量（0，-1）.MergeArea.Count 并设置 lastmergerow = j + k -1 （减去1得到MergeArea的结尾）。

但是，关键是在循环范围内设置和更新变量。在下面的代码中，我更新了范围的开始和结束行，以防止合并超出A列中的MergeArea。这使我可以在B列中合并顺序匹配的值，同时保持在A列的MergeArea中。

尽可能避免使用合并的单元格！！！但是，在极少数人需要执行此操作的情况下，我希望以下代码能有所帮助。

我的FinalCode：

    Sub MergeB()
    ' Merge Category (Column B) where sequentially matching rows exist while staying within the range of merged cells in Administration (Column A)
    ' Turn off screen updating
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Dim Current As Worksheet
    Dim lrow As Long
    Dim k As Long
    Dim j As Long
    Dim bRow As Long
    Dim endRow As Long
        For Each Current In ActiveWorkbook.Worksheets
        bRow = 2
        lrow = Cells(Rows.Count, 2).End(xlUp).Row
        endRow = Cells(Rows.Count, 2).End(xlUp).Row
    MergeAgain:
        Set rngMerge = Current.Range("B" & bRow & ":B" & lrow)
                    For Each cell In rngMerge
                    If cell.Offset(0, -1).MergeCells Then
                        k = cell.Offset(0, -1).MergeArea.Count
                        j = cell.Offset(0, -1).MergeArea.Row
                        lastmergerow = j + k - 1
                        m = k - 1
                    End If
                    Dim i As Integer
                        For i = 1 To m
                            If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False And bRow < lastmergerow Then
                                Range(cell, cell.Offset(1, 0)).Merge
                                bRow = bRow + 1
                            Else
                                bRow = bRow + 1
                                lrow = lastmergerow
                                If bRow > endRow Then
                                    GoTo NextSheet
                                End If
                                If bRow > lrow Then
                                    lrow = endRow
                                End If
                                GoTo MergeAgain
                            End If
                        Next i
                                bRow = lastmergerow + 1
                                lrow = endRow
                                GoTo MergeAgain
                    Next
    NextSheet:
                Next Current
    ' Turn screen updating back on
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Call AutoFit
    End Sub

VBA Excel-基于列A合并合并列B中的单元格

1 个答案: