|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub test()
arr = Sheets("表一").[a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 3 To UBound(arr)
If arr(i, 1) = "" Then
xm = arr(i, 2)
fb = Split(arr(i, 2), " ")(1)
nfb = ""
For k = 1 To Len(fb)
If Asc(Mid(fb, k, 1)) < 30 Then nfb = nfb & Mid(fb, k, 1)
Next
If Not d.exists(nfb) Then
d(nfb) = Array(arr(i, 4), arr(i, 5), arr(i, 6))
Else
d(nfb) = Array(d(nfb)(0) + arr(i, 4), d(nfb)(1) + arr(i, 5), d(nfb)(2) + arr(i, 6))
End If
End If
Next
ReDim brr(1 To d.Count, 1 To 4)
For Each fb In d.keys
m = m + 1
brr(m, 1) = fb
brr(m, 2) = d(fb)(0)
brr(m, 3) = d(fb)(1)
brr(m, 4) = d(fb)(2)
Next
Sheets("汇总信息").[c20].Resize(m, 4) = brr
End Sub
|
|