数据处理

zhangcheng6688

学习一下字典，打扰了
Sub test()
arr = [a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
   If Not d.exists(arr(i, 1)) Then
      d(arr(i, 1)) = arr(i, 2)
   Else
      d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2)
   End If
Next
lastr = Cells(Rows.Count, "f").End(xlUp).Row
brr = Range("f4:g" & lastr)
For i = 1 To UBound(brr)
   brr(i, 2) = d(brr(i, 1))
Next
[f4].Resize(UBound(brr), 2) = brr
End Sub

yanglinzi

1. Sub test()
   
2. Dim arr, brr, i, j, d
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. For i = 1 To UBound(arr)
   
6.     sa = arr(i, 1)
   
7.     d(sa) = d(sa) & "," & arr(i, 2)
   
8. Next
   
9. ReDim brr(1 To d.Count, 1 To 2)
   
10. For Each k In d.keys
    
11.     n = n + 1
    
12.     brr(n, 1) = k
    
13.     brr(n, 2) = Mid(d(k), 2)
    
14. Next
    
15. [f10].Resize(n, 2) = brr
    
16. End Sub

复制代码

yanglinzi

参与一下、、