合并相同的单元格

时间:2021-07-10 02:06:59

标签: excel vba dynamic merge

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

之前

enter image description here

之后

enter image description here

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

另外,为了获得更多见解,我将 =Mod(Row(),2) = 0 用于白色背景,将 = 1 用于灰色,不确定合并时是否无法正确翻译,因为我遇到了问题。

1 个答案:

答案 0 :(得分:0)

如果您愿意插入一个临时小计列,如下面的 gif 所示。您还可以在表格右侧的某个位置创建一个虚拟列。该列的目的是从新添加的小计列中捕获空白单元格。 例如,在 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

enter image description here