求问，如何查找其他工作簿的某个工作表的数据

月阙也 · 发表于 2025-4-14 21:04

求大神帮忙，这个文件夹里面有多个公司的工作簿，每个工作簿都有多个不同月份的的工作表，怎么把总金额汇总到汇总统计的表格呢？

mx76947 · 发表于 2025-4-14 22:20

可以用VBA做循环，不过最好先规范一下表格式

chenguiyu1234 · 发表于 2025-4-14 22:32

可以搜索一下“PQ汇总文件夹数据”，需要表格格式一致

ykcbf1100 · 发表于 2025-4-15 06:42

多文件多表汇总，这个还是比较适合用VBA的

附件供参考。。。

ykcbf1100 · 发表于 2025-4-15 06:44

Sub ykcbf() '//2025.4.15 多文件多表排重汇总
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = CreateObject("Scripting.Dictionary")
p = ThisWorkbook.Path & ""
Set Sh = ThisWorkbook.Sheets("Sheet1")
ReDim brr(1 To 10000, 1 To 100)
m = 1: n = 1
brr(1, 1) = "公司名"
Dim tm: tm = Timer
On Error Resume Next
For Each f In fso.GetFolder(p).Files
If LCase$(f.Name) Like "*.xls*" Then
If InStr(f.Name, ThisWorkbook.Name) = 0 Then
m = m + 1
brr(m, 1) = fso.GetBaseName(f)
Set wb = Workbooks.Open(f, 0)
For Each sht In wb.Sheets
If IsArray(sht.UsedRange) Then
s = sht.Name
If Not d.exists(s) Then
n = n + 1
d(s) = n
brr(1, n) = s
End If
c = d(sht.Name)
With sht
Set Rng = .Columns(1).Find("序号")
r1 = Rng.Row
c1 = .Rows(r1).Find("合计").Column
r = .Columns(1).Find("合计").Row
brr(m, c) = .Cells(r, c1).Value
End With
End If
Next
wb.Close 0
End If
End If
Next
With Sh
.UsedRange.Clear
.Cells.Interior.ColorIndex = 0
.[a1].Resize(1, n).Interior.Color = 49407
.[a2].Resize(m - 1, 1).Interior.Color = 5296274
With .[a1].Resize(m, n)
.Value = brr
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
With .Font
.Name = "微软雅黑"
.Size = 11
End With
End With
Set Rng = .[a2].Resize(m - 1, n)
Rng.Sort Rng.Columns(1), 1, Orientation:=1
End With
Application.ScreenUpdating = True
MsgBox "共用时：" & Format(Timer - tm, "0.000") & "秒！"
End Sub

复制代码

3190496160 · 发表于 2025-4-15 09:09

Sub 多薄多表合并()
Application.ScreenUpdating = False
Dim ar()
Dim rn As Range
Dim d As Object
Set d = CreateObject("scripting.dictionary")
ReDim ar(1 To 1000, 1 To 13)
ar(1, 1) = "公司名称"
n = 1: k = 1
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "*.xls*")
Do While f <> ""
If f <> ThisWorkbook.Name Then
      Set wb = Workbooks.Open(lj & f, 0)
      mc = Replace(wb.Name, ".xls", "")
      n = n + 1
      ar(n, 1) = mc
      For Each sh In wb.Worksheets
         Set rn = sh.Rows(5).Find("合计", , , , , , 1)
         If Not rn Is Nothing Then
            r = sh.Cells(Rows.Count, 1).End(xlUp).Row
            y = rn.Column
            yf = Replace(sh.Name, "份", "") & "统计"
            lh = d(yf)
            If lh = "" Then
                  k = k + 1
                  d(yf) = k
                  lh = k
                  ar(1, k) = yf
            End If
            ar(n, lh) = sh.Cells(r, y)
         End If
      Next sh
      wb.Close False
End If
f = Dir
Loop
With ActiveSheet
With .[a1].CurrentRegion
      .ClearContents
      .Borders.LineStyle = 0
End With
.[a1].Resize(n, k) = ar
.[a1].Resize(n, k).Borders.LineStyle = 1
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2025-4-15 09:10

新建文件夹.rar (27.76 KB, 下载次数: 6)

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

[求助] 求问，如何查找其他工作簿的某个工作表的数据

评分

评分

评分

评分