多个单元表汇总 比较复杂

ykcbf1100

app240913 发表于 2024-9-13 18:38
已经更新了，你再看下

你分表的备注这样放，应该是无法汇总到总表去的。建议你放到类型列中去为宜。

app240913

ykcbf1100 发表于 2024-9-13 18:32
分表都没有日期字段，你汇总表怎么会有呢？

你好我加你QQ了，可以通过下吗

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.9.13
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set sh = ThisWorkbook.Sheets("类型汇总")
   
4.     ReDim brr(1 To 100000, 1 To 100)
   
5.     On Error Resume Next
   
6.     For Each sht In Sheets
   
7.         If sht.Name <> sh.Name Then
   
8.             arr = sht.UsedRange
   
9.             For j = 4 To UBound(arr, 2)
   
10.                 If arr(10, j) <> Empty Then
    
11.                     For i = 11 To UBound(arr)
    
12.                         If arr(i, j) <> Empty Then
    
13.                             s = arr(1, 3) & "|" & arr(10, j) & "|" & arr(9, j) & "|" & arr(i, 1)
    
14.                             If Not d.exists(s) Then
    
15.                                 m = m + 1
    
16.                                 d(s) = m
    
17.                                 brr(m, 1) = arr(10, j)
    
18.                                 brr(m, 2) = arr(1, 3)
    
19.                                 brr(m, 3) = arr(9, j)
    
20.                                 brr(m, 4) = arr(i, 1)
    
21.                                 brr(m, 5) = arr(i, j)
    
22.                                 brr(m, 12) = sht.Name
    
23.                             Else
    
24.                                 r = d(s)
    
25.                                 brr(r, 5) = brr(r, 5) + arr(i, j)
    
26.                             End If
    
27.                         End If
    
28.                     Next
    
29.                 End If
    
30.             Next
    
31.         End If
    
32.     Next
    
33.     With sh
    
34.         .UsedRange.Offset(1).ClearContents
    
35.         .[a2].Resize(m, 12) = brr
    
36.     End With
    
37.     MsgBox "OK！"
    
38. End Sub
    
39. 
    

复制代码

quqiyuan

ykcbf1100 发表于 2024-9-13 19:11
附件供参考。。。

草爷真有耐心，牛！！！

app240913

ykcbf1100 发表于 2024-9-13 19:12
参与一下。。。

很好用 非常感谢！！！