遍历工作表遍历工作簿并条件汇总到对应工作表

火火蒲

1. 根据“源文件夹”里面的工作簿（不止4个）中工作表名为“00”内B列的值（AAA\BBB\CCC\DDD\EEE）遍历“汇总结果表”的工作表，如果工作表名存在，则忽略；如果不存在则在后面新建工作表，并将第一个工作表（AAA）里面的内容复制到新建立的表格。每个工作簿都需要用工作表“00里”B列的值遍历一次“汇总结果表”的工作表，如果工作表名存在，则忽略；如果不存在则在后面新建工作表，并将第一个工作表（AAA）里面的内容复制到新建立的表格。

2. 遍历“源文件夹”下的工作簿（不止4个），当打开工作簿WK1的“00”工作表时，筛选B列（如AAA）并汇总年月字段的值（H-M列的值）填入“汇总结果表”对应的工作表（AAA表）里面对应的WK1所在的行，对应年月字段的列。

liulang0808

http://club.excelhome.net/thread-1258425-1-1.html遍历文件的资料，供楼主参考

3190496160

Sub test()
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Set dic = CreateObject("scripting.dictionary")
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "模板" Then
        d(sh.Name) = ""
    End If
Next sh
Set sht = ThisWorkbook.Worksheets("模板")
With sht
    ws = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:h" & ws)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        dc(Trim(ar(i, 1))) = i
    End If
Next i

f = Dir(ThisWorkbook.Path & "\源文件夹\*.xls*")
Do While f <> ""
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\源文件夹\" & f, 0)
    With wb.Worksheets("00")
        br = .[a1].CurrentRegion
    End With
    For i = 2 To UBound(br)
        If Trim(br(i, 2)) <> "" Then
            dic(Trim(br(i, 2))) = ""
        End If
    Next i
    For Each k In dic.keys
        If Not d.exists(k) Then
            m = dc(Split(wb.Name, ".")(0))
            n = 0
            ReDim cr(1 To UBound(br), 1 To UBound(br, 2))
            sht.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = k
            d(k) = ""
            For i = 2 To UBound(br)
                If Trim(br(i, 2)) = k Then
                    n = n + 1
                    For j = 1 To UBound(br, 2)
                        cr(n, j) = br(i, j)
                    Next j
                End If
            Next i
            For j = 8 To 13
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Cells(m, j - 6) = Application.Sum(Application.Index(cr, 0, j))
            Next j
        End If
    Next k
    wb.Close False
f = Dir
Loop
End Sub

3190496160

总感觉你的思路是有问题的，所以，代码仅供参考
遍历工作表汇总.rar (83.13 KB, 下载次数: 23)

2020-3-18 09:48 上传

点击文件名下载附件

renkangjizhen

用DIR循环获取工作部名称并打开，用usedrange和数组记录表格内容，写入目标工作部的工作表

火火蒲

3190496160 发表于 2020-3-18 09:48
总感觉你的思路是有问题的，所以，代码仅供参考

谢谢，非常感谢！

火火蒲

3190496160 发表于 2020-3-18 09:46
Sub test()
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionar ...

大神，如果B列的AAA/BBB/CCC/DDD/EEE/FFF有大小写（不需要区分大小写），用UCASE可以处理建立表名，但是汇总不完全（程序可以运行，未报错），感谢大好人，帮到底，谢谢！