|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub hz()
Dim sht As Worksheet
Dim arr, i, Keys, Its, It, j
Dim dic
Set dic = CreateObject("scripting.dictionary")
For Each sht In Sheets
If sht.Name <> "汇总表" Then
arr = sht.UsedRange
For i = 2 To UBound(arr)
dic(arr(i, 1)) = arr(i, 6) & "," & arr(i, 8) & "," & arr(i, 9)
Next
End If
Next
Keys = dic.Keys
Its = dic.items
ReDim brr(0 To dic.Count - 1, 1 To 4)
For i = 0 To dic.Count - 1
brr(i, 1) = Keys(i)
It = Split(Its(i), ",")
For j = 0 To UBound(It)
brr(i, j + 2) = It(j)
Next
Next
Sheets("汇总表").Cells(2, 1).Resize(UBound(brr, 1), UBound(brr, 2)) = brr
End Sub
|
|