关于多条件、多表汇总，请老师帮忙看一下，谢谢

颛孙蓝

各位老师：你们好！
麻烦帮忙看一下，关于多条件、多表汇总的，非常感谢！

不知道为什么

这类汇总的代码论坛实在是太多！有时候真不想写了，但是看到别人求助，自己又会，感觉不帮心理会内疚！
如图，是你需要的效果？

不知道为什么

代码送上，自行测试把

鄂龙蒙

1. Sub 多表汇总()
   
2.     Dim sh As Worksheet
   
3.     Dim j, i, ar, br(), m%
   
4.     Range("A3:I10000").ClearContents
   
5.     Application.ScreenUpdating = False
   
6.         For Each sh In Worksheets
   
7.             If IsNumeric(Left(sh.Name, 2)) Then
   
8.                 ar = sh.Range("A1").CurrentRegion
   
9.                 For i = 2 To UBound(ar)
   
10.                     If ar(i, 2) <> "" Then
    
11.                         m = m + 1
    
12.                         ReDim Preserve br(1 To 9, 1 To m)
    
13.                         br(1, m) = m
    
14.                         For j = 2 To 9
    
15.                             br(j, m) = ar(i, j)
    
16.                         Next
    
17.                     End If
    
18.                 Next
    
19.             End If
    
20.         Next
    
21.     [A3].Resize(m, 9) = Application.Transpose(br)
    
22.     Application.ScreenUpdating = True
    
23. End Sub

复制代码

jjmysjg

留下记号。两位高手的代码结果不一呀

不知道为什么

jjmysjg 发表于 2018-6-21 21:10
留下记号。两位高手的代码结果不一呀

四楼大神 代码 没有判断 自有  的这个条件把

颛孙蓝

不知道为什么 发表于 2018-6-21 19:59
这类汇总的代码论坛实在是太多！有时候真不想写了，但是看到别人求助，自己又会，感觉不帮心理会内疚！
如 ...

已测试，是我要的结果，非常感谢