合并相同的单元格

Question

我在创建宏以合并表格中的相同单元格时遇到了一些困难（实际上不是表格，但您知道我的意思）。而不是我尝试解释它，让我向您展示我正在尝试做的事情之前和之后。

之前

之后

我能够为它创建一个宏，但它要么搞砸了我的条件格式，要么没有正确调整表格编号，或者类似的东西。无论如何，这就是我想要做的，希望有人知道我该如何解决这个问题。

另外，为了获得更多见解，我使用=Mod(Row(),2) = 0 表示白色背景，= 1 表示灰色，不确定合并时是否无法正确转换，因为我一直遇到问题。

Answer 1

如果您愿意插入一个临时小计列，如下图所示。您还可以在表格右侧远处的某处创建一个虚拟列。该列的目的是从新添加的小计列中捕获空白单元格。 例如，在 gif 中，您可以从表的 ColA、B、C 创建表的连接列 ColF。该列可以在工作表列 Z 上创建，并可用于该列的小计。然后新添加的小计列可以用来捕获空白单元格（如gif B列所示）

主要好处是我们不必遍历每个单元格

Option Explicit

Sub MergeDupCells()
Application.DisplayAlerts = False
'https://stackoverflow.com/questions/68324153/merge-same-cells
Dim blnkCls As Range, mrgRng As Range, i As Long

Sheet3.Range("B3:B19").Subtotal GroupBy:=1, Function:=xlCount, _
        TotalList:=Array(1), Replace:=True, PageBreaks:=False, _
        SummaryBelowData:=True
Set blnkCls = Sheet3.Range("B3:B" & Sheet3.Range("B" & Sheet3.Rows.Count).End(xlUp).Row)
Set mrgRng = blnkCls.SpecialCells(xlCellTypeBlanks)

For i = 1 To Sheet3.Range("B3:B19").CurrentRegion.Columns.Count - 2
    If i = 4 Or i = 5 Then GoTo next_i
    With mrgRng.Offset(0, i)
        .Merge
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .Interior.Color = vbYellow
    End With
next_i:
Next i
blnkCls.Rows.Ungroup
blnkCls.Rows.Ungroup

blnkCls.SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete
Sheet3.Range("B:B").EntireColumn.Delete

End Sub