遍历工作表，按照条件将固定区域内的数据汇总至新的sheet内

winnieliao

RT，如何使用数组或者字典，遍历工作表，将固定区域内的非空数据按照条件汇总到新的工作表中，具体需求如附件，请各位大神帮忙看一下，谢谢@

iwangyi

楼主的汇总表SHEET7表头为2020年，统计数据1-6表为2019年

xiangbaoan

Option Explicit
Sub test()
Dim Cn As Object, Sq$, ar, s$, sh As Worksheet
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
Worksheets("Sheet7").Activate
ar = ActiveSheet.[a1:m1&""]
s = "[" & Join(ar, "],[") & "]"
For Each sh In Worksheets
    If sh.Name <> ActiveSheet.Name Then
        Sq = Sq & " UNION ALL SELECT " & s & " FROM [" & sh.Name & "$A1:Y] WHERE [Type] IS NOT NULL"
    End If
Next
ActiveSheet.UsedRange.Offset(1).Clear 'Contents
[a2].CopyFromRecordset Cn.Execute(Mid(Sq, 12))
[a1].CurrentRegion.Offset(1, 1).NumberFormatLocal = "0%"
Cn.Close
Set Cn = Nothing
End Sub

xiangbaoan

………………

EXCELLMY

xiangbaoan 发表于 2019-12-15 09:06
………………

ADO同薄多表合并，老师的代码炉火纯青了

xiangbaoan

EXCELLMY 发表于 2019-12-15 11:07
ADO同薄多表合并，老师的代码炉火纯青了

，向大家学习。

winnieliao

iwangyi 发表于 2019-12-15 08:49
楼主的汇总表SHEET7表头为2020年，统计数据1-6表为2019年

这是其中的一个条件，2019年的不统计

winnieliao

xiangbaoan 发表于 2019-12-15 09:03
Option Explicit
Sub test()
Dim Cn As Object, Sq$, ar, s$, sh As Worksheet

非常感谢，本人VBA新手，希望能向各位前辈学习，将来也有能力帮助别人，再次感谢！

winnieliao

xiangbaoan 发表于 2019-12-15 11:40
，向大家学习。

谢谢解答，在套用代码的过程中出现了一些问题，附件是目标工作簿，更改代码后会出现一些问题，望帮忙看看是啥问题，谢谢！

winnieliao

这是目标工作簿，请帮忙debug一下，谢谢！