Excel VBA - 基於重複搜索合併單元格

Question

我需要幫助編寫VBA代碼以在一列中查找重複值，然後合併基於該搜索的單元格。 E.g：

France 6216 EDE 009789 Company A 
France 6216 EDF 009790 Company A 
France 6216 EDG 009791 Company A 
Germany 6216 EDH 009792 Company B 

變爲：

France 6216 EDE EDF EDG 009789 009790 009791 Company A 
Germany 6216 EDH   009792     Company B 

它在一個大的電子表格，其中一些受騙者將有兩個，但有些可能是多達八個。 任何人都可以幫助我嗎？

有任何問題，請讓我知道。

非常感謝！

Answer 1

試試這個宏，

Sub removeDupes() 
    Dim i As Long, j As Long, k As Long 
    Columns("A:E").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlYes 
    Sheets.Add.Name = "newSheet" 
    Sheets("newSheet").Cells(1, 1) = Cells(2, 1) 
    Sheets("newSheet").Cells(1, 2) = Cells(2, 2) 
    Sheets("newSheet").Cells(1, 3) = Cells(2, 3) 
    Sheets("newSheet").Cells(1, 150) = Cells(2, 4) 
    Sheets("newSheet").Cells(1, 255) = Cells(2, 5) 
    j = 1 
    k = 1 
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 
     If Cells(i + 1, 1) = Cells(i, 1) Then 
      Sheets("newSheet").Cells(j, 3 + k) = Cells(i + 1, 3) 
      Sheets("newSheet").Cells(j, 150 + k) = Cells(i + 1, 4) 
      k = k + 1 
     Else 
      j = j + 1 
      Sheets("newSheet").Cells(j, 1) = Cells(i + 1, 1) 
      Sheets("newSheet").Cells(j, 2) = Cells(i + 1, 2) 
      Sheets("newSheet").Cells(j, 3) = Cells(i + 1, 3) 
      Sheets("newSheet").Cells(j, 150) = Cells(i + 1, 4) 
      Sheets("newSheet").Cells(j, 255) = Cells(i + 1, 5) 
      k = 1 
     End If 
    Next i 
    For i = 255 To 1 Step -1 
     If Sheets("newSheet").Cells(1, i) = "" Then 
      Sheets("newSheet").Columns(i).Delete 
     End If 
    Next i 
End Sub 

來源：

輸出：