多个不规则的数据表怎么用VBA汇总

jiaqitang

我的工作簿有几张店铺的数据表。想把数据都汇集在一张总表上。店铺数据的样式有两种，分别在店铺A，店铺B里展现（B中多了一个项REVENUE的数据）。

我把希望汇总的样式贴在了汇总表里。如果店铺某产品类别下没数据，那在汇总表里不需要显示这一类别（显示空值或0也可以）。工作簿里除了汇总，信息，备注三个SHEET，其它的SHEET都是店铺表，一共10几张，但样式就两种，像A，B那样的。

这样复杂的，VBA能实现吗？

tanglf188

能，但你要把特殊情况说明，现在提问的人很奇怪，只说个大概，别人写好了就一堆问题了，然后就是各种修改。

jiaqitang

都差不多说明了。也是在摸索。没有模板，也是想像出来的。

moonlit123

做是可以做到的。
参考昨天你问的这个帖子案例，实现的代码思路是差不多的
https://club.excelhome.net/thread-1652931-1-1.html

但是我多问一句，“店铺”表的格式都是固定的吗，最多8个地区/产品类别？不会随意增加/缩减么？位置会变动吗，比如现在是固定B3/B22开头的，会不会有个别表从A1/C40开始做新表头？

如果你给出的案例很模糊，那么代码只能限定适应你所给到的案例情况，并不能复制粘贴应用到其他更宽泛的实例上去。
如果你想完整应用到自己的实例上，要么学习一下别人的代码到底是怎么实现的思路，试着理解代码思路后自己改写一下。要么把实例可能遇到的情况都做进案例里，把复杂情况说明清楚，让别人知道你所想要达到的目标到底是什么。

因为可能你多补充一句“店铺表里可能不止有8个小表头，表头位置不确定，小表的行数不确定”，
别人可能就只能推翻之前写的几十行代码，重新构思代码方案，思考如何找表头、如何定位、如何判断兼容性，代码量可能翻倍或几何倍数增加。

jiaqitang

都说明了。我也是在摸索，没有模板。

jiaqitang

moonlit123 发表于 2023-2-10 09:36
做是可以做到的。
参考昨天你问的这个帖子案例，实现的代码思路是差不多的
https://club.excelhome.net/t ...

我明白了大佬们的意思了。

店铺表格样式固定。目前就 8个地区/类别，每个店铺都是一样的地区/类别，8个。 就算以后增加到 16个，每个店铺也是一样的，不会几个多另几个少。这是模板。都是固定 B3/B22开头。

蓝桥玄霜

汇总的例子：

3190496160

Sub 汇总()
Application.ScreenUpdating = False
Dim br As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim ar()
ReDim ar(1 To 10000, 1 To 6)
With Sheets("汇总")
    .[a1].CurrentRegion.Offset(1) = Empty
    For Each sh In Sheets
        If sh.Index > 3 Then
            br = sh.UsedRange
            mc = sh.Name
            For i = 1 To UBound(br) Step 19
                For j = 1 To UBound(br, 2) - 1
                    If Trim(br(i + 2, j)) = "Accounting Number" Then
                        For s = i + 3 To i + 17
                            If s <= UBound(br) Then
                                If Trim(br(s, j)) <> "" Then
                                    n = n + 1
                                    ar(n, 1) = sh.Name
                                    ar(n, 2) = br(i, j)
                                    ar(n, 3) = br(i + 1, j)
                                    ar(n, 4) = br(s, j)
                                    If Trim(br(i + 2, j + 1)) = "Revenue" Then  ''
                                        ar(n, 5) = br(s, j + 1)
                                        ar(n, 6) = br(s, j + 2)
                                    ElseIf Trim(br(i + 2, j + 1)) = "Expense" Or Trim(br(i + 2, j + 1)) = "Payment" Then
                                        ar(n, 5) = ""
                                         ar(n, 6) = br(s, j + 1)
                                    End If
                                End If
                            End If
                        Next s
                    End If
                Next j
            Next i
        End If
    Next sh
    .[a2].Resize(n, 6) = ar
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

store.rar (24.14 KB, 下载次数: 19)

2023-2-10 10:35 上传

点击文件名下载附件