求助：多表汇总到一表，求大神帮帮忙！

水吉空

多表汇总到一表.rar (41.83 KB, 下载次数: 12)

2020-5-6 15:06 上传

点击文件名下载附件

龙蒙山

1. Sub 取数()
   
2.     Range("C2:I1000") = Empty
   
3.     Dim brr(), arr, i, j, s, m, sht
   
4.     For Each sht In Sheets
   
5.         If InStr(sht.Name, "表四") Then
   
6.             arr = sht.UsedRange
   
7.             For i = 8 To UBound(arr)
   
8.                  If arr(i, 5) > 0 Then
   
9.                     m = m + 1
   
10.                     ReDim Preserve brr(1 To 5, 1 To m)
    
11.                     brr(1, m) = sht.Name
    
12.                     brr(2, m) = arr(i, 2)
    
13.                     brr(3, m) = arr(i, 3)
    
14.                     brr(4, m) = arr(i, 5)
    
15.                 End If
    
16.             Next
    
17.         End If
    
18.     Next
    
19.     For i = 1 To m
    
20.         For j = 3 To 5
    
21.             If Cells(1, j) = brr(1, i) Then brr(5, i) = j
    
22.         Next
    
23.     Next
    
24.     s = Sheet5.[A65536].End(3).Row
    
25.     For i = 2 To s
    
26.         For j = 1 To m
    
27.             If Cells(i, 1) = brr(2, j) And Cells(i, 2) = brr(3, j) Then
    
28.                 Cells(i, brr(5, j)) = brr(4, j)
    
29.             End If
    
30.         Next
    
31.     Next
    
32. End Sub

复制代码

水吉空

只需要汇总数量那一列。

水吉空

龙蒙山 发表于 2020-5-6 15:08

谢谢大神