这段代码将
- 在当前工作表上的 A:D 列上运行
- 将 A 列和 B 列中常见的记录与 C 列和 D 列的组合值分别组合在一起
- 运行不区分大小写
- 输出到新工作表
Sub QuickCombine()
Dim X()
Dim Y()
Dim objDic As Object
Dim lngRow As Long
Dim lngCol As Long
Dim ws As Worksheet
X = Range([a1], Cells(Rows.Count, "D").End(xlUp))
Y = X
Set objDic = CreateObject("scripting.dictionary")
For lngRow = 1 To UBound(X, 1)
If Not objDic.exists(LCase$(X(lngRow, 1) & X(lngRow, 2))) Then
objDic.Add LCase$(X(lngRow, 1) & X(lngRow, 2)), lngRow
Else
Y(lngRow, 1) = vbNullString
Y(objDic.Item(LCase$(X(lngRow, 1) & X(lngRow, 2))), 3) = Y(objDic.Item(LCase$(X(lngRow, 1) & X(lngRow, 2))), 3) & "," & X(lngRow, 3)
Y(objDic.Item(LCase$(X(lngRow, 1) & X(lngRow, 2))), 4) = Y(objDic.Item(LCase$(X(lngRow, 1) & X(lngRow, 2))), 4) & "," & X(lngRow, 4)
End If
Next
Set ws = Sheets.Add
ws.[a1].Resize(UBound(X, 1), UBound(X, 2)) = Y
ws.Columns("A").SpecialCells(xlBlanks).EntireRow.Delete
End Sub