提取分表合并总表求助

娜美小姐

模拟总表和分表在压缩文件中，谢谢

wang-way

1. <blockquote>Private Sub Workbook_Open()

复制代码

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.17
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Set sh = ThisWorkbook.Sheets("合并总表")
   
5.     p = ThisWorkbook.Path & ""
   
6.     ReDim brr(1 To 1000, 1 To 9)
   
7.     For Each f In fso.GetFolder(p).Files
   
8.         If InStr(f.Name, ThisWorkbook.Name) = 0 Then
   
9.             fn = fso.GetBaseName(f)
   
10.             m = m + 1
    
11.             brr(m, 1) = fn
    
12.             Set wb = Workbooks.Open(f, 0)
    
13.             With wb.Sheets("建设项目结算汇总表")
    
14.                 r = .Columns(3).Find("合计", LookAt:=xlWhole).Row
    
15.                 For j = 7 To 14
    
16.                     brr(m, j - 5) = .Cells(r, j)
    
17.                 Next
    
18.             End With
    
19.             wb.Close False
    
20.         End If
    
21.     Next f
    
22.     With sh
    
23.         .UsedRange.Offset(1).Clear
    
24.         .[a1].Resize(1, 9).Interior.Color = 49407
    
25.         With .[a2].Resize(m, 9)
    
26.             .Value = brr
    
27.             .Borders.LineStyle = 1
    
28.             .HorizontalAlignment = xlCenter
    
29.             .VerticalAlignment = xlCenter
    
30.         End With
    
31.     End With
    
32.     Application.ScreenUpdating = True
    
33.     MsgBox "OK！"
    
34. End Sub
    

复制代码

ykcbf1100

。。。。。。。。。。。。。

娜美小姐

ykcbf1100 发表于 2024-6-17 20:00
附件供参考。。。

麻烦您复制提供下代码，WPS无法运行该宏

ykcbf1100

娜美小姐 发表于 2024-6-17 20:18
麻烦您复制提供下代码，WPS无法运行该宏

代码已上传，正在审核中