合并重复的单元格并组合其他列中的值

时间:2016-07-12 03:12:01

标签: excel vba

很抱歉,我是VBA的新手。我试图搜索相关的答案,但未能解决我需要的问题。我有一个包含许多列的数据列表。基本上我想合并B列中的相同单元格,然后在同一张纸上合并所有其他唯一值(从C列到X)

Before

After

非常感谢!

1 个答案:

答案 0 :(得分:1)

我会使用scripting.dictionary来执行此操作。

您必须修改范围和工作表名称以适应。如果要超过1000行数据,还需要处理数组的大小。

Sub dave()

Dim dicKey As String
Dim dicValues As String
Dim dic
Dim data
Dim x(1 To 1000, 1 To 24)
Dim j As Long
Dim count As Long
Dim lastrow As Long

    lastrow = Cells(Rows.count, 1).End(xlUp).Row
     data = Range("A2:X" & lastrow) ' load data into variable
             With CreateObject("scripting.dictionary")
                    For i = 1 To UBound(data)
                         If .Exists(data(i, 2)) = True Then 'test to see if the key exists
                             x(count, 3) = x(count, 3) & ";" & data(i, 3)
                             x(count, 5) = x(count, 5) & ";" & data(i, 5)
                             x(count, 8) = x(count, 8) & ";" & data(i, 8)
                             x(count, 9) = x(count, 9) & ";" & data(i, 9)
                         Else
                            count = count + 1
                            dicKey = data(i, 2) 'set the key
                            dicValues = data(i, 2) 'set the value for data to be stored
                            .Add dicKey, dicValues
                            For j = 1 To 24
                              x(count, j) = data(i, j)
                            Next j
                         End If
                      Next i
              End With

              Sheets("Sheet2").Cells(2, 1).Resize(count - 1, 9).Value = x
End Sub