Объединение повторяющихся ячеек и объединение значений в других столбцах

Question

Извините, что я новичок в VBA. Я попытался найти соответствующие ответы, но не смог решить, что мне нужно. У меня есть список данных со многими столбцами. В основном я хочу, чтобы объединить одинаковые ячейки в столбце B, а затем объединить все другие уникальные значения (из столбца C в X) на одном листе

Before

After

Спасибо вам большое!

Answer 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