|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
请参考:- Sub 数据汇总()
- Dim d As Object, sh As Worksheet
- Dim arr, brr(1 To 65536, 1 To 8), i&, j&, m&, r, s$
- Set d = CreateObject("scripting.dictionary")
- For Each sh In Worksheets
- If sh.Name <> "汇总" And sh.Name <> "材料名称" And sh.Name <> "清单模板" And sh.Name Like Range("L1") & "*" Then
- arr = sh.[A6:H26]
- For i = 1 To UBound(arr)
- If Len(arr(i, 1)) Then
- s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
- r = d(s)
- If r = "" Then
- m = m + 1
- d(s) = m
- For j = 1 To 8
- If j <> 6 And j <> 7 Then brr(m, j) = arr(i, j)
- Next
- Else
- brr(r, 4) = brr(r, 4) + arr(i, 4)
- brr(r, 5) = brr(r, 5) + arr(i, 5)
- brr(r, 8) = brr(r, 8) + arr(i, 8)
- End If
- End If
- Next
- End If
- Next
- Range("B3").Resize(m, 8) = brr
- End Sub
复制代码 |
评分
-
2
查看全部评分
-
|