|
- Private Sub CommandButton1_Click()
- Dim dic As Object
- Dim arr, KeyItem, KeyValue As String
-
- Dim lLastrow As Long
- lLastrow = Cells(Rows.Count, 1).End(xlUp).Row
- If lLastrow = 1 Then Exit Sub
- arr = Range("a2:b" & lLastrow)
- Set dic = CreateObject("scripting.dictionary")
- For i = LBound(arr) To UBound(arr)
- dic(arr(i, 1)) = dic(arr(i, 1)) & arr(i, 2) & " & "
- Next
-
- For Each KeyItem In dic.keys
- KeyValue = dic(KeyItem)
- dic(KeyItem) = Left(KeyValue, Len(KeyValue) - 3)
- Next
-
- lLastrow = Cells(Rows.Count, 4).End(xlUp).Row
- Application.ScreenUpdating = False
- If lLastrow > 1 Then Range("d2:e" & lLastrow) = ""
- If dic.Count > 0 Then
- Range("d2").Resize(dic.Count) = WorksheetFunction.Transpose(dic.keys)
- Range("e2").Resize(dic.Count) = WorksheetFunction.Transpose(dic.items)
- MsgBox "OK"
- End If
- Set dic = Nothing
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|