VBA Excel - 根据A列合并合并B列中的单元格答案

【问题标题】：VBA Excel - Merge cells in column B based on column A mergeVBA Excel - 根据A列合并合并B列中的单元格
【发布时间】：2019-02-11 23:53:16
【问题描述】：

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

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

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

这是我打算让它看起来的样子：

我当前的代码：

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

任何有关完成此操作的指导将不胜感激！

【问题讨论】：

对于初学者，您应该将ScreenUpdating 和DisplayAlerts 重新“打开”，方法是在True 之后将它们设置回True
使用 进行检查？ cell.Offset(-1,0).MergeArea.Address 以确保 A 列单元格范围内的最后一行
@Marcucciboy2 严格来说，Excel 会自动将ScreenUpdating 重置为 True，但就我而言，我更喜欢明确说明。
感谢@Cyril 的建议。我在 If 语句中添加了以下内容，但它并没有改变结果。 如果 cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False And cell.Row
@JohnMiller 检查涉及完整的“？cell.offset(-1,0).mergearea.address”，它应该提供一个范围。您需要确定该范围的最后一行，最好将其保存为变量（k），然后您的 if 语句包括 cell.row

标签： vba excel mergesort

【解决方案1】：

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

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

尽可能避免使用合并单元格！！！但是，在很少有人需要这样做的情况下，我希望下面的代码有所帮助。

我的最终代码：

子合并B() ' 合并类别（B 列），其中存在顺序匹配的行，同时保持在管理中的合并单元格范围内（A 列） ' 关闭屏幕更新 Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayAlerts = False 出错时继续下一步调暗电流作为工作表昏暗只要暗淡 k 只要暗淡 j 只要昏暗的眉毛 Dim endRow As Long 对于 ActiveWorkbook.Worksheets 中的每个当前 bRow = 2 lrow = Cells(Rows.Count, 2).End(xlUp).Row endRow = Cells(Rows.Count, 2).End(xlUp).Row 再次合并：设置 rngMerge = Current.Range("B" & bRow & ":B" & lrow) 对于 rngMerge 中的每个单元格 If cell.Offset(0, -1).MergeCells Then k = cell.Offset(0, -1).MergeArea.Count j = cell.Offset(0, -1).MergeArea.Row 最后合并 = j + k - 1 米 = k - 1 万一将 i 调暗为整数对于 i = 1 至 m 如果 cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False And bRow &lt lastmergerow Then Range(cell, cell.Offset(1, 0)).Merge bRow = bRow + 1 别的 bRow = bRow + 1 lrow = lastmergerow If bRow &gt endRow Then 转到下一个工作表万一 If bRow &gt lrow Then lrow = endRow 万一再次合并万一接下来我 bRow = 最后合并行 + 1 lrow = endRow 再次合并下一个下一页：下一个当前 ' 重新开启屏幕更新 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayAlerts = True 调用自动调整结束子

【讨论】：