多工作簿中的某一个指定sheet内容汇总!

ykcbf1100

无语住了我 发表于 2024-6-17 11:41
可以加个规则，汇总完毕时，还可以显示汇总了文件名字及总数吗？

汇总文件名，这个如何体现呢？一个文件一个文件显示吗？
汇总总数，这个没问题的。

无语住了我

ykcbf1100 发表于 2024-6-17 11:54
汇总文件名，这个如何体现呢？一个文件一个文件显示吗？
汇总总数，这个没问题的。

共合并了几个工作薄下，如下：1、X，2、XXX~~~第N个。这种格式。之前在网上收藏的有个汇总文件内所有表格的，里头可以实现这种的。


Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName

Dim Wb As Workbook, WbN As String

Dim G As Long

Dim Num As Long

Dim BOX As String

Application.ScreenUpdating = False

MyPath = ActiveWorkbook.Path

MyName = Dir(MyPath & "\" & "*.xls")

AWbName = ActiveWorkbook.Name

Num = 0

Do While MyName <> ""

If MyName <> AWbName Then

Set Wb = Workbooks.Open(MyPath & "\" & MyName)

Num = Num + 1

With Workbooks(1).ActiveSheet

.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

Wb.Sheets(G).UsedRange.Offset(1).Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)

Next

WbN = WbN & Chr(13) & Wb.Name

Wb.Close False

End With

End If

MyName = Dir

Loop

Range("B1").Select

Application.ScreenUpdating = True

MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"

End Sub

无语住了我

汇总表格总数：多少个
然后显示汇总表格名称列表
1、xxxx
2、xxxx
3、xxxx
........
n、xxxx

无语住了我

无语住了我

ykcbf1100 发表于 2024-6-17 11:54
汇总文件名，这个如何体现呢？一个文件一个文件显示吗？
汇总总数，这个没问题的。

求助，大佬！
若是示例表格中的数据，是工作簿中多表链接的数据，那我汇总使用的您提供的VBA，数据可能出现报错，或者直接报错无效（#REF!）
可以让它断开表格数据链接吗？
让汇总表格完成状态的数据都为数值呢？

ykcbf1100

无语住了我 发表于 2024-6-17 13:37
汇总表格总数：多少个
然后显示汇总表格名称列表
1、xxxx

这个可以做的，稍等。

ykcbf1100

无语住了我 发表于 2024-6-17 13:37
汇总表格总数：多少个
然后显示汇总表格名称列表
1、xxxx

改好了。。。

ykcbf1100

新增文件信息显示。

1. Sub ykcbf()  '//2024.6.18   增加合并文件信息显示
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
5.     Dim tm: tm = Timer
   
6.     Set sh = ThisWorkbook.Sheets("原料价格预测")
   
7.     sh.UsedRange.Clear
   
8.     p = ThisWorkbook.Path & ""
   
9.     For Each f In Fso.GetFolder(p).Files
   
10.         If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
11.             fn = Fso.GetBaseName(f)
    
12.             Set wb = Workbooks.Open(f, 0)
    
13.             m = m + 1
    
14.             If m = 1 Then
    
15.                 st = m & "、" & fn
    
16.             Else
    
17.                 st = st & Chr(10) & m & "、" & fn
    
18.             End If
    
19.             With wb.Sheets("原料价格预测")
    
20.                 If m = 1 Then
    
21.                     .Cells.Copy sh.[a1]
    
22.                     sh.Rows(5).Delete
    
23.                 Else
    
24.                     r = sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
    
25.                     .UsedRange.Offset(5).Copy sh.Cells(r, 1)
    
26.                 End If
    
27.             End With
    
28.             wb.Close False
    
29.         End If
    
30.     Next f
    
31.     sh.Activate
    
32.     Application.ScreenUpdating = True
    
33.     MsgBox "共合并了：" & m & "个文件，文件名如下：" & Chr(10) & st
    
34. End Sub
    
35. 
    

复制代码

ykcbf1100

无语住了我 发表于 2024-6-18 15:31
求助，大佬！
若是示例表格中的数据，是工作簿中多表链接的数据，那我汇总使用的您提供的VBA，数据可能 ...

再改一次吧，合并后的总表数据都为数值。

ykcbf1100

总表数据处理为仅数值

1. Sub ykcbf()  '//2024.6.18   增加合并文件信息显示
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
5.     Dim tm: tm = Timer
   
6.     Set sh = ThisWorkbook.Sheets("原料价格预测")
   
7.     sh.UsedRange.Clear
   
8.     p = ThisWorkbook.Path & ""
   
9.     For Each f In Fso.GetFolder(p).Files
   
10.         If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
11.             fn = Fso.GetBaseName(f)
    
12.             Set wb = Workbooks.Open(f, 0)
    
13.             m = m + 1
    
14.             If m = 1 Then
    
15.                 st = m & "、" & fn
    
16.             Else
    
17.                 st = st & Chr(10) & m & "、" & fn
    
18.             End If
    
19.             With wb.Sheets("原料价格预测")
    
20.                 If m = 1 Then
    
21.                     .Cells.Copy sh.[a1]
    
22.                     sh.Rows(5).Delete
    
23.                 Else
    
24.                     r = sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
    
25.                     .UsedRange.Offset(5).Copy sh.Cells(r, 1)
    
26.                 End If
    
27.             End With
    
28.             wb.Close False
    
29.         End If
    
30.     Next f
    
31.     With sh
    
32.         arr = .UsedRange
    
33.         .UsedRange = arr
    
34.     End With
    
35.     sh.Activate
    
36.     Application.ScreenUpdating = True
    
37.     MsgBox "共合并了：" & m & "个文件，文件名如下：" & Chr(10) & st
    
38. End Sub
    

复制代码