请求老师的帮助，关于从多个工作表中汇总数据到单表

aloreg

各位老师好，小弟在日常工作中处理Excel数据汇总中遇到了难题，想请各位老师指点，感激不尽！
文件描述：两个工作簿，一个为“各省数据”，里面根据不同的省份分了多个工作表；另一个为“汇总”，只有一张表；（如图）

各省数据表

汇总表

操作描述：现在要将“各省数据”里面的明细按照单项汇总到“汇总”表中，比如
问题描述：（1）在数据表（各省数据）中垂直纵列的数据，汇总到“汇总表”里面要变为水平方向排列；
（2）”各省数据表“中各个工作表中的数据都要汇总到”汇总表“内；
（3）数据表中纵列单项的数据按照1月、2月、3月的规律循环，对应着汇总表里面水平的三个表格（如图）；也就是说汇总表里面，每一行的数据，是数据表中对应单项的纵列的汇集；（如图）

（4）汇总表里面，希望能够根据下拉菜单（A1），切换不同的单项统计显示；
（5）各省数据表内的数据会按照时间定期增加，如何实现定期将其数据添加到“汇总表”内？
以上问题，老师们可以给我提出一些帮助吗？谢谢！ test.zip (25.16 KB, 下载次数: 11)

2020-3-11 00:17 上传

点击文件名下载附件

aloreg

附上文件包，谢谢

opel-wong

aloreg 发表于 2020-3-11 00:17
附上文件包，谢谢

这个，从技术上来说不难，用数组，字典，即可以实现。但是，从实际分析，代码量蛮大的，真的需要点时间。
看看谁有空帮你写写吧，

不知道为什么

比较好奇，你的销量  和 销售量 是什么区别？

3190496160

确实是个数组+字典的典型案例，只是稍微麻烦一些，先留个足印吧，稍后看看再说

renkangjizhen

技术上来说不难，代码量蛮大

gxx75

VBA学习中, 勉强拼凑一个

aloreg

gxx75 发表于 2020-3-11 11:00
VBA学习中, 勉强拼凑一个

我马上下载来用，谢谢大佬！

aloreg

不知道为什么 发表于 2020-3-11 08:25
比较好奇，你的销量  和 销售量 是什么区别？

抱歉是我没写清楚，其实“销售量”指的是通过个人销售的数量

3190496160

Sub test()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set sh = ThisWorkbook.Worksheets(1)
If sh.[a1] = "销量" Then
    y = 3
ElseIf sh.[a1] = "销售金额" Then
    y = 7
ElseIf sh.[a1] = "销售量" Then
    y = 8
End If
sh.Range("b3:ab6") = Empty
ar = sh.Range("a1:ab6")
For j = 2 To UBound(ar, 2)
    If Trim(ar(1, j)) = "" Then ar(1, j) = ar(1, j - 1)
Next j
For j = 2 To UBound(ar, 2)
    If Trim(ar(1, j)) <> "" And Trim(ar(2, j)) <> "" Then
        d(Trim(ar(1, j)) & "|" & Trim(ar(2, j))) = j
    End If
Next j
For i = 3 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        d(Trim(ar(i, 1))) = i
    End If
Next i
f = Dir(ThisWorkbook.Path & "\各省数据.XLSX")
If f <> "" Then
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
    For Each sht In wb.Worksheets
        br = sht.UsedRange
        For i = 2 To UBound(br)
            m = d(Trim(br(i, 1)))
            n = d(sht.Name & "|" & Trim(br(i, 2)))
            If n <> "" And m <> "" Then
                ar(m, n) = ar(m, n) + br(i, y)
            End If
        Next i
    Next sht
    wb.Close False
End If
sh.Range("a1:ab6") = ar
MsgBox "ok!"
End Sub