|
|
本帖最后由 笨鸟飞不高 于 2020-6-15 22:27 编辑
Sub AwTest()
Dim i%, j%, k%, m%, r%, c%, s%, sr$, srX$, srS$, arr, ws As Worksheet, d As Object
Set d = CreateObject("Scripting.Dictionary")
For Each ws In Sheets
If ws.Name <> "总表" Then
arr = ws.[b1].CurrentRegion
For i = 4 To UBound(arr) - 1
If Len(arr(i, 1)) Then srS = arr(i, 1)
If Not d.exists(srS) And Not d.exists(srS & "|" & arr(i, 2)) Then
d(srS) = "": d(srS & "|" & arr(i, 2)) = ""
d(srS & "|" & "序列") = 1
ElseIf d.exists(srS) And Not d.exists(srS & "|" & arr(i, 2)) Then
d(srS & "|" & arr(i, 2)) = ""
k = d(srS & "|" & "序列") + 1
d(srS & "|" & "序列") = k
End If
Next
For j = 3 To UBound(arr, 2) - 1
If Len(arr(2, j)) Then srX = arr(2, j)
If Not d.exists(srX) And Not d.exists(srX & "|" & arr(3, j)) Then
d(srX) = "": d(srX & "|" & arr(3, j)) = ""
d(srX & "|" & "序列") = 1
ElseIf d.exists(srX) And Not d.exists(srX & "|" & arr(3, j)) Then
d(srX & "|" & arr(3, j)) = ""
m = d(srX & "|" & "序列") + 1
d(srX & "|" & "序列") = m
End If
Next
End If
Next
ReDim brr(1 To 1000, 1 To 100)
brr(1, 1) = "2009销量汇总表": brr(2, 1) = "省份": brr(2, 2) = "销售网点"
k = 3: m = 2
For Each ws In Sheets
If ws.Name <> "总表" Then
arr = ws.[b1].CurrentRegion
For i = 4 To UBound(arr) - 1
If Len(arr(i, 1)) Then srS = arr(i, 1)
If Not d.exists(srS & "|" & "总") And Not d.exists(srS & "|" & arr(i, 2) & "|" & "总") Then
d(srS & "|" & "总") = ""
d(srS & "|" & arr(i, 2) & "|" & "总") = ""
k = k + 1
d(srS & "|" & "总序列") = k
brr(k, 1) = arr(i, 1)
brr(k, 2) = arr(i, 2)
k = k + d(srS & "|" & "序列") - 1
ElseIf d.exists(srS & "|" & "总") And Not d.exists(srS & "|" & arr(i, 2) & "|" & "总") Then
d(srS & "|" & arr(i, 2) & "|" & "总") = ""
r = d(srS & "|" & "总序列") + 1
brr(r, 2) = arr(i, 2)
d(srS & "|" & "总序列") = r
End If
Next
For j = 3 To UBound(arr, 2) - 1
If Len(arr(2, j)) Then srX = arr(2, j)
d(sr) = d(sr) + arr(i, j)
If Not d.exists(srX & "|" & "总") And Not d.exists(srX & "|" & arr(3, j) & "|" & "总") Then
d(srX & "|" & "总") = ""
d(srX & "|" & arr(3, j) & "|" & "总") = ""
m = m + 1
d(srX & "|" & "总序列") = m
brr(2, m) = arr(2, j)
brr(3, m) = arr(3, j)
m = m + d(srX & "|" & "序列") - 1
ElseIf d.exists(srX & "|" & "总") And Not d.exists(srX & "|" & arr(3, j) & "|" & "总") Then
d(srX & "|" & arr(3, j) & "|" & "总") = ""
c = d(srX & "|" & "总序列") + 1
brr(3, c) = arr(3, j)
d(srX & "|" & "总序列") = c
End If
Next
End If
Next
brr(k + 1, 1) = "合计": brr(2, m + 1) = "合计"
For Each ws In Sheets
If ws.Name <> "总表" Then
arr = ws.[b1].CurrentRegion
For i = 4 To UBound(arr) - 1
If Len(arr(i, 1)) Then srS = arr(i, 1)
For j = 3 To UBound(arr, 2) - 1
If Len(arr(2, j)) Then srX = arr(2, j)
sr = srS & "|" & arr(i, 2) & "|" & srX & "|" & arr(3, j)
d(sr) = d(sr) + arr(i, j)
Next
Next
End If
Next
For i = 4 To k
If Len(brr(i, 1)) Then srS = brr(i, 1)
For j = 3 To m
If Len(brr(2, j)) Then srX = brr(2, j)
sr = srS & "|" & brr(i, 2) & "|" & srX & "|" & brr(3, j)
If d.exists(sr) Then brr(i, j) = d(sr): _
brr(i, m + 1) = brr(i, m + 1) + brr(i, j): brr(k + 1, j) = brr(k + 1, j) + brr(i, j) _
: s = s + brr(i, j)
Next
Next
brr(k + 1, m + 1) = s
With Sheets("总表")
.Cells.Clear
.[b1].Resize(k + 1, m + 1) = brr
End With
End Sub
汇总表为空的情况，凑一个！！ |
|
楼主: 彭希仁
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2020-6-12 15:42
