多文件夹多工作簿指定工作表汇总

dxysong0811 · 发表于 2020-1-26 15:15

多文件夹多工作簿指定工作表汇总
详见附件

约定的童话 · 发表于 2020-1-26 17:28

网上那些汇总工具试了没有？方方格子那些

dxysong0811 · 发表于 2020-1-26 18:35

具体代码怎么写呢，需要多次使用，多个名为[水果]的工作表，汇总成一个工作表

dxysong0811 · 发表于 2020-1-26 18:35

约定的童话发表于 2020-1-26 17:28
网上那些汇总工具试了没有？方方格子那些

具体代码怎么写呢，需要多次使用，多个名为[水果]的工作表，汇总成一个工作表

3190496160 · 发表于 2020-1-26 21:49

一个vba字典问题，楼主可以研究一下数组和字典的知识，或者，自己找找论坛里面类似的帖子

3190496160 · 发表于 2020-1-26 22:26

Sub hz()
Application.ScreenUpdating = False
Set sh = ThisWorkbook.ActiveSheet
ar = sh.Range("a1:m1000")
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
For j = 2 To UBound(ar, 2)
If Trim(ar(1, j)) <> "" Then
      d(Trim(ar(1, j))) = j
End If
Next j
f = Dir(ThisWorkbook.Path & "\" & sh.Name & "年\*.xls*")
n = 1
Do While f <> ""
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & sh.Name & "年\" & f, 0)
With wb.Worksheets("水果")
      ws = .Cells(Rows.Count, 1).End(xlUp).Row
      br = .Range("a1:c" & ws)
      m = d(Trim(br(1, 2)))
      If m <> "" Then
         For i = 2 To UBound(br)
            If Trim(br(i, 2)) <> "" Then
                  If Not dc.exists(Trim(br(i, 2))) Then
                     n = n + 1
                     ar(n, 1) = br(i, 2)
                     ar(n, m) = br(i, 3)
                     dc(Trim(br(i, 2))) = n
                  ElseIf dc.exists(Trim(br(i, 2))) Then
                     t = dc(Trim(br(i, 2)))
                     ar(t, m) = br(i, 3)
                  End If
            End If
         Next i
      End If
End With
wb.Close False
f = Dir
Loop
sh.[a1].Resize(n, UBound(ar, 2)) = ar
Application.ScreenUpdating = True
End Sub

3190496160 · 发表于 2020-1-26 22:29

实验用数据.zip (356.56 KB, 下载次数: 28)

answer6141 · 发表于 2020-1-26 22:52

先标记下

answer6141 · 发表于 2020-1-27 00:16

你这要求有点刁钻啊
大苹果
大梨
中梨
小梨
梨合计
等待大神出现

jjmysjg · 发表于 2020-1-27 10:54

3190496160 发表于 2020-1-26 22:29

把代码中的“水果”改为“蔬菜”，没有汇总进来数据。怎么改才对呢

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

[求助] 多文件夹多工作簿指定工作表汇总

评分

最新热点 /1