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

zhaogang1960 · 发表于 2011-6-25 19:07

原帖由商人于 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-26 01:26

原帖由 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 · 发表于 2011-6-26 11:11

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

商人 · 发表于 2011-6-26 11:54

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

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

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

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

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

zhaogang1960 · 发表于 2011-6-26 13:21

原帖由商人于 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 · 发表于 2011-6-26 13:23

详见附件

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

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

商人 · 发表于 2011-6-26 13:56

原帖由 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 · 发表于 2011-6-26 14:53

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

kszcs · 发表于 2011-6-26 17:26

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

zhaogang1960 · 发表于 2011-6-26 18:01

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

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

		自动登录	找回密码
密码			免费注册

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

回复 12楼商人的帖子

回复 18楼 zhaogang1960 的帖子

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

回复 12楼 商人 的帖子

回复 18楼 zhaogang1960 的帖子

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

回复 12楼商人的帖子