急急急！！多工作薄合并设置区域问题！！

wzp8888

急急急！！多工作薄合汇总方式有误，望老师指点！！！详见附件！！

z865593849

汇总完处理，可去除函数

蓝桥玄霜

汇总的例子：

wzp8888

z865593849 发表于 2024-11-20 10:54
汇总完处理，可去除函数

谢谢老师，能不能上个附件，本人VBA菜鸟啊！！还望一起指点，希望代码里注解一下。

wzp8888

蓝桥玄霜 发表于 2024-11-20 11:31
汇总的例子：

我何德何能能让蓝桥老师亲自指导，万分感谢蓝桥老师的代码：老师能不能上个附件！！

wzp8888

蓝桥玄霜 发表于 2024-11-20 11:31
汇总的例子：

另外请教一下老师：汇总方式有误，详见附件！！！

zpy2

select  colIndex[0:19] from consolidateSheet where rowid=15 union all
select colIndex[0:19] from consolidateSheet where f05 GLOB '*[0-9][0-9]*' ;

wzp8888

zpy2 发表于 2024-11-20 20:10
select  colIndex[0:19] from consolidateSheet where rowid=15 union all
select colIndex[0:19] from c ...

感谢老师的回复，能不能上个附件学习一下

zpy2

wzp8888 发表于 2024-11-20 21:07
感谢老师的回复，能不能上个附件学习一下

这个是在线工具，入口请查看我的日志

蓝桥玄霜

1. Sub 工作薄汇总() '可汇总薄名和工作表名
   
2.     Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet, m&, Brr(1 To 50000, 1 To 20)
   
3.     Dim n%, i%, j%, Crr
   
4.     Application.ScreenUpdating = False
   
5.     Set sh = ActiveSheet
   
6.     MyPath = ThisWorkbook.Path & "\明细"
   
7.     MyName = Dir(MyPath & "*.xls?")
   
8.     [E15].CurrentRegion.Offset(1).Clear
   
9.     Do While MyName <> ""
   
10.         If MyName <> ThisWorkbook.Name Then
    
11.             With GetObject(MyPath & MyName)
    
12.                 For Each sht In .Sheets
    
13.                     n = sht.Cells(sht.Rows.Count, 5).End(xlUp).Row - 1
    
14.                     Crr = sht.[e16].Resize(n, 18)
    
15.                     If n >= 15 Then
    
16.                         For i = 1 To UBound(Crr)
    
17.                             m = m + 1
    
18.                             Brr(m, 1) = MyName: Brr(m, 2) = sht.Name
    
19.                             For j = 1 To UBound(Crr, 2)
    
20.                                 Brr(m, j + 2) = Crr(i, j)
    
21.                             Next
    
22.                         Next
    
23.                     End If
    
24.                 Next
    
25.                 .Close False
    
26.             End With
    
27.         End If
    
28.         MyName = Dir
    
29.     Loop
    
30.     sh.[e16].Resize(m, 20) = Brr
    
31.     Application.ScreenUpdating = True
    
32.     MsgBox "ok"
    
33. End Sub

复制代码