首页 > 解决方案 > 合并具有相同值VBA的单元格

问题描述

我想合并具有相同值的单元格。我查看了有关此的其他主题,但没有一个是相同的。

WI05000002
WI05000002
WI05000002
WI05000002
WI05000002
WI05000002
WI05000002
WI05000002
WqP01650012
WqP01650012
WqP01650012
WqP01650012
WqP01650012
WqP01650012
WqP01650012 

输入数据:
在此处输入图像描述

期望的结果:
在此处输入图像描述

Sub scalanie()


Dim P As Range ' deklaracja zmiennej P
  Dim komorka As Range ' deklaracja komórki

Application.DisplayAlerts = False
  Set P = Selection.Cells(1, 1)       ' zapamiętaj pierwszą komórkę z zaznaczenia
  For Each komorka In Selection       ' dla każdej komórki w zaznaczeniu
    If komorka = P Then               ' jeśli komórka jest taka sama jak P
      Range(komorka.Offset(0, 0), P).Merge ' scal powyżej komórki do P
                            ' zapamiętaj komórkę
    End If
  Next komorka  ' przejdź do następnej komórki

  Application.DisplayAlerts = True
End Sub

标签: excelvbamergecell

解决方案


您的代码几乎是正确的。问题是 的值P始终设置为等于第一个单元格Set P = Selection.Cells(1, 1),并且永远不会改变。这就是您选择的第二部分(即WqP01650012)不合并的原因。

尝试使用以下代码:

Sub scalanie()
    Dim P As Range ' deklaracja zmiennej P
    Dim komorka As Range ' deklaracja komórki

    Application.DisplayAlerts = False

      For Each komorka In Selection       ' dla kazdej komórki w zaznaczeniu
        On Error Resume Next
        If komorka.Value = komorka.End(xlUp).Value Then
            Range(komorka, komorka.Offset(-1, 0)).Merge
        End If
        On Error GoTo 0
      Next komorka  ' przejdz do nastepnej komórki

    Application.DisplayAlerts = True
End Sub

结果:

在此处输入图像描述


推荐阅读