汇总同文件夹下的表，出现错误！

hrnike

3190496160 发表于 2024-2-2 10:40
那就增加一列写入文件名称不就行了吗？

不会，这个咋写

3190496160

在ab列写入文件名称
如何快速汇总-1版本2 - 副本.rar (210.84 KB, 下载次数: 15)

2024-2-2 11:17 上传

点击文件名下载附件

hrnike

3190496160 发表于 2024-2-2 11:17
在ab列写入文件名称

大侠，就是傻瓜式的合并（B店不需要删除表头的内容和合计的内容） 每家店的表头不一样，这样虽然合并了，但能知道每家店，这样合并在一起，没有店名了（A店，B店）

ykcbf1100

hrnike 发表于 2024-2-22 20:39
大侠，就是傻瓜式的合并（B店不需要删除表头的内容和合计的内容） 每家店的表头不一样，这样虽然合并了， ...

参与一下。。。

ykcbf1100

代码供参考。。。

1. Sub ykcbf()  '//2024.2.23
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set sh = ThisWorkbook.Sheets("汇总")
   
5.     sh.UsedRange.ClearContents
   
6.     p = ThisWorkbook.Path & ""
   
7.     f = Dir(p & "*.xls*")
   
8.     m = 0
   
9.     On Error Resume Next
   
10.     Do While f <> ""
    
11.         If InStr(f, ThisWorkbook.Name) = 0 Then
    
12.             Set wb = Workbooks.Open(p & f, 0)
    
13.             Set sht = wb.Sheets("人力成本")
    
14.             arr = sht.UsedRange
    
15.             m = m + 1
    
16.             If m = 1 Then
    
17.                 sht.UsedRange.Copy sh.[a1]
    
18.                 sh.[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
19.             Else
    
20.                 r = sh.UsedRange.Find("*", , -4163, , 1, 2).Row + 1
    
21.                 sht.UsedRange.Copy sh.Cells(r, 1)
    
22.                 sh.Cells(r, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
    
23.             End If
    
24.             wb.Close False
    
25.         End If
    
26.         f = Dir
    
27.     Loop
    
28.     sh.Cells.Replace What:="#REF!", Replacement:="0", LookAt:=xlPart, _
    
29.         SearchOrder:=xlByRows, FormulaVersion:=xlReplaceFormula2
    
30.     sh.Range("b5").Select
    
31.     Application.ScreenUpdating = True
    
32.     MsgBox "合并完毕!"
    
33. End Sub
    

复制代码

hrnike

ykcbf1100 发表于 2024-2-23 09:39
参与一下。。。

大侠请手下小弟膝盖