[已解决]各位老师，请教关于跨表统计合计的问题

晃晃悠悠517

    各位老师，有个难题想您们请教，在附件中有北京等地的家用电器的销售情况的简易报表，实际上有19张表格，有没有办法在一张汇总表中反应出各类家用电器的销售总额，在附加中的各地的数据是每月有变化的，我实在想不出有什么办法，工作量太大了，水平不够，请各位老师指导一下，
    另外有没有办法给几张名称是“新建 Microsoft Office Excel 97-2003 工作表”或者是“复件 新建 Microsoft Office Excel 97-2003 工作表”、“ 复件 (2)  新建 Microsoft Office Excel 97-2003 工作表”的工作表按照自定义的顺序（北京、天津、上海）更改工作薄名称

最佳答案

月排行榜 / 总排行榜

zjdh

2012-12-21 18:40

汇总.rar (33.38 KB, 下载次数: 62)

2012-12-21 18:40 上传

点击文件名下载附件

跳转到最佳答案楼层

zjdh

汇总.rar (33.38 KB, 下载次数: 62)

2012-12-21 18:40 上传

点击文件名下载附件

zjdh

第二个问题没有必要了吧！有多少工作量啊？

晃晃悠悠517

感谢老师的回复，马上看一下

hans_beer

可以把宏贴上来么，也想学习下。

晃晃悠悠517

zjdh 发表于 2012-12-21 18:40

非常非常感谢老师的指导，真心祝您圣诞快乐，这段代码有不明白的还要多多请教您，

晃晃悠悠517

M = 1         ‘这是什么意思
    Dirs = Dir(ThisWorkbook.Path & "\*.xls")   Dirs是什么
    While Dirs <> ""
        If Dirs <> ThisWorkbook.Name Then
            myDatePath = ThisWorkbook.Path & "\" & Dirs
您这段代码的整体思路您是怎样考虑的，以我的现有知识理解有点困难
实际的应用可能还需要改变一些，再次感谢您

zjdh

Sub HZ()
    Application.ScreenUpdating = False  '关闭屏幕刷新
    Range("A2:I65536").ClearContents    '清除记录
    ARR = Range("A1:I500")              '设置数组
    M = 1                               '预设指针
    Dirs = Dir(ThisWorkbook.Path & "\*.xls")  '在同一目录中提取一个文件xls名
    While Dirs <> ""                   '直到提取完毕
        If Dirs <> ThisWorkbook.Name Then   '若文件不是本文件
            myDatePath = ThisWorkbook.Path & "\" & Dirs   '设置路径及文件名称
            Set WB = GetObject(myDatePath)     '打开文件
            BRR = WB.Sheets(1).UsedRange       '提取该文件表一的所有内容
            For J = 2 To UBound(BRR)           '对提取的内容逐行循环
                For I = 2 To UBound(ARR)       '对汇总数据内容逐行循环
                    If BRR(J, 2) = ARR(I, 2) Then  '若名称一致
                        For K = 3 To 9             '逐项相加
                            ARR(I, K) = ARR(I, K) + BRR(J, K)
                        Next
                        Exit For
                    End If
                Next
                If I > 500 Then          '若汇总数据中没有
                    M = M + 1            '修正指针
                    ARR(M, 1) = M - 1    '记录序号
                    For K = 2 To 9       '逐项记录
                        ARR(M, K) = BRR(J, K)
                    Next
                End If
            Next
            WB.Close False     '关闭文件
        End If
        Dirs = Dir             '提取下一个文件名称
    Wend
    Application.ScreenUpdating = True  '开启屏幕刷新
    Range("A1").Resize(M, 9) = ARR     '将数据输入到汇总表
    MsgBox "汇总完毕!"
End Sub

晃晃悠悠517

谢谢zjdh老师，已经打印放在身边有时间就学习，真的、真的非常感谢您的注解，我要更加努力学习，争取早点掌握，祝您元旦快乐

晃晃悠悠517

zjdh 发表于 2012-12-27 16:01
Sub HZ()
    Application.ScreenUpdating = False  '关闭屏幕刷新
    Range("A2:I65536").ClearContent ...

谢谢zjdh老师，已经打印放在身边有时间就学习，真的、真的非常感谢您的注解，我要更加努力学习，争取早点掌握，祝您元旦快乐