1-12月 不同表头标题（字段）数据合并(非常感谢zhaogang1960等老师)

zhaogang1960

原帖由 商人 于 2011-6-25 18:05 发表


我再提出个新问题，如果标题字段行是从B3单元格开始的，而且，B3上方是合并单元格并且有文字。又该如何修改代码呢？
改成：
arr = ..CurrentRegion   是不能解决的，因为上面有合并单元格且有文字。

如何动 ...

arr = .[b3].Resize(.[b65536].End(xlUp).Row - 2, .[iv3].End(xlToLeft).Column - 1)
1-12月 不同表头标题（字段）数据合并-加入合并单元格标题.rar (15.97 KB, 下载次数: 213)

2011-6-25 19:07 上传

点击文件名下载附件

商人

原帖由 zhaogang1960 于 2011-6-25 19:07 发表

arr = ..Resize(..End(xlUp).Row - 2, ..End(xlToLeft).Column - 1)
946376

再次谢谢赵刚老师！又同您学到了一种动态区域的表达式子，

模仿表达一下：
如果改成 arr = .[b3].Resize(.[b65536].End(xlUp).Row - 2, .[b3].End(xlToRight).Column - 1)
应该是同 arr = .[b3].Resize(.[b65536].End(xlUp).Row - 2, .[iv3].End(xlToLeft).Column - 1)    是一样的结果的吗？

[ 本帖最后由 商人 于 2011-6-26 01:37 编辑 ]

zhaogang1960

如果第3行标题中间没有空格，效果一致

商人

原帖由 zhaogang1960 于 2011-6-26 11:11 发表
如果第3行标题中间没有空格，效果一致

谢谢赵刚老师的指导！同表格里的我学会了，但是我还想加点难度的，将单独只是汇总单一工作表格的，改为：多工作簿，同格式不同标题汇总。

效果见下图！文件见附件！

老师的代码相当简洁，汇总多工作簿的，HOME里有不少，office2008(wxyqxxz2007)的SQL，

不知赵老师一般是如何解决的？

zhaogang1960

原帖由 商人 于 2011-6-26 11:54 发表


谢谢赵刚老师的指导！同表格里的我学会了，但是我还想加点难度的，将单独只是汇总单一工作表格的，改为：多工作簿，同格式不同标题汇总。

效果见下图！文件见附件！

老师的代码相当简洁，汇总多工作簿的， ...

你的数据源不太规范，否则可以用SQL语句导入，连透视表都可以省略
下面代码是根据上面一个工作簿代码修改的，请测试：
Sub Macro1()
    Dim arrpath$(), arr, brr(), sh As Worksheet, i&, j&, m&, n&, k&, d As Object
    Dim myPath$, myFile$, wb As Workbook, s$, w$
    Set d = CreateObject("scripting.dictionary")
    d("工作簿") = 1
    d("工作表") = 2
    m = 2
    Set wb1 = ThisWorkbook
    Application.ScreenUpdating = False
    myPath = ThisWorkbook.Path & "\数据源\"
    myFile = Dir(myPath & "*.xls")
    Do While myFile <> ""
            n = n + 1 '工作簿计数
            ReDim Preserve arrpath(1 To n) '重新定义工作簿路径数组
            arrpath(n) = myPath & myFile '记录工作簿路径
            Set wb = GetObject(arrpath(n)) '调用这个工作簿
            For Each sh In wb.Sheets
                With sh
                    If IsSheetEmpty = IsEmpty(.UsedRange) Then
                        arr = .[b3].Resize(.[b65536].End(xlUp).Row - 2, .[iv3].End(xlToLeft).Column - 1)
                        For j = 1 To UBound(arr, 2)
                            If Not d.Exists(arr(1, j)) Then
                                m = m + 1
                                d(arr(1, j)) = m
                            End If
                        Next
                    End If
                End With
            Next
            wb.Close False
        myFile = Dir
    Loop
    ReDim brr(1 To 60000, 1 To d.Count)
    m = 0
    For k = 1 To n '逐个工作簿
        w = Split(Split(arrpath(k), "\")(UBound(Split(arrpath(k), "\"))), ".")(0)
        Set wb = GetObject(arrpath(k)) '调用工作簿
        For Each sh In wb.Sheets
            With sh
                If IsSheetEmpty = IsEmpty(.UsedRange) Then
                    s = .Name
                    arr = .[b3].Resize(.[b65536].End(xlUp).Row - 2, .[iv3].End(xlToLeft).Column - 1)
                    For i = 2 To UBound(arr)
                        m = m + 1
                        brr(m, 1) = w
                        brr(m, 2) = s
                        For j = 1 To UBound(arr, 2)
                            brr(m, d(arr(1, j))) = arr(i, j)
                        Next
                    Next
                End If
            End With
        Next
        wb.Close False
    Next
    ActiveSheet.UsedRange.ClearContents
    [a1].Resize(, d.Count) = d.Keys
    [a2].Resize(m, d.Count) = brr
    Application.ScreenUpdating = True
    MsgBox "汇总完毕"
End Sub

[ 本帖最后由 zhaogang1960 于 2011-6-26 13:28 编辑 ]

zhaogang1960

详见附件
多工作簿，同格式不同标题汇总.rar (39.17 KB, 下载次数: 310)

2011-6-26 13:29 上传

点击文件名下载附件

[ 本帖最后由 zhaogang1960 于 2011-6-26 13:29 编辑 ]

商人

原帖由 zhaogang1960 于 2011-6-26 13:21 发表

你的数据源不太规范，否则可以用SQL语句导入，连透视表都可以省略
下面代码是根据上面一个工作簿代码修改的，请测试：
Sub Macro1()
    Dim arrpath$(), arr, brr(), sh As Worksheet, i&, j&, m&, n&, k&, d  ...

再次对老师帮助致谢！！！测试了没有丝毫问题！SQL不知速度如何，透视表的汇总我倒是领教了，几乎秒杀104万行的汇总。
透视表是个超级牛工具。

老师说的规范是这样的形式吗？

1、数据的每个工作簿的每一工作表从第一列和第一行开始，以第一行和列的长宽范围定整个数据范围。

2、如果可以，则每一个公司的1-12各月的表格的标题名和数量全部相同（这个一般需要对下属公司下文要求统一）。实际应用中，我个人偏向允许每个公司因情况自己增减标题数量，灵活性强些。

zhaogang1960

在《使用vba生成汇总多个工作簿的多工作表数据透视表SQL命令文本》中要求数据源是个从A1开始的连续区域，字段可多可少，某个工作表中如果不存在这个字段，SQL语句中要用0 as 字段代替，你的附件中前两列不能缺少。
SQL速度比数组慢，但不需要打开工作簿，整体应该比15楼代码快些

kszcs

zhaogang1960 老师的功底深不可测，佩服之极

zhaogang1960

原帖由 kszcs 于 2011-6-26 17:26 发表
zhaogang1960 老师的功底深不可测，佩服之极

谢谢夸奖，看来真要找本书好好看一看了，否则对不住你对我的夸奖了，哈哈