Sub 按钮1_Click()

Application.ScreenUpdating = False
arr = Range("a1:c" & [a65536].End(xlUp).Row)
[g1].CurrentRegion.ClearContents
Cells(1, "g") = arr(1, 1)
Cells(1, "h") = arr(1, 2)
Cells(1, "i") = arr(1, 3)
r = 1
For i = 2 To UBound(arr)
If arr(i, 1) <> arr(i - 1, 1) And arr(i, 1) <> "" Then
r = r + 1
Cells(r, "g") = arr(i, 1)
End If
Cells(r, "iv").End(xlToLeft).Offset(0, 1) = arr(i, 2)
Cells(r, "iv").End(xlToLeft).Offset(0, 1) = arr(i, 3)
Next
Application.ScreenUpdating = True
End Sub

exel中合并一列相同的数据到一行