求大神，请教如何提料每张工作表的一列数据！？

vicio

论坛里各位大神：

      请各位大神喝咖啡！
     我有一个需求一直没想不出有什么好办法！？求助一下各位大神！
      需求： 我手头这工作簿（因机密，我大概设计了一下），假设有36张辅助工作表，每张表的统一A列都是单据编号（供应商 ），我如何在一张新的工作表里把36张表的单据编号（供应商 ）提炼出来，如果有重复就合并；有空白就忽略，并且计算C列的采购额！
      感谢大家

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.19
   
2.     Dim arr, brr, d
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set sh = ThisWorkbook.Sheets("汇总")
   
5.     col = 3 '//汇总列号
   
6.     For Each sht In Sheets
   
7.         If Val(sht.Name) Then
   
8.             With sht
   
9.                 r = .Cells(Rows.Count, 1).End(3).Row
   
10.                 arr = .Range("a5:d" & r)
    
11.                 For i = 2 To UBound(arr)
    
12.                     s = arr(i, 1)
    
13.                     If Not d.exists(s) Then
    
14.                         d(s) = Array(s, Val(arr(i, col)))
    
15.                     Else
    
16.                         t = d(s)
    
17.                         t(1) = t(1) + Val(arr(i, col))
    
18.                         d(s) = t
    
19.                     End If
    
20.                 Next
    
21.             End With
    
22.         End If
    
23.     Next
    
24.     With sh
    
25.         .UsedRange.Offset(1).Clear
    
26.         With .[a2].Resize(d.Count, 2)
    
27.             .Value = Application.Rept(d.Items, 1)
    
28.             .Borders.LineStyle = 1
    
29.             .HorizontalAlignment = xlCenter
    
30.             .VerticalAlignment = xlCenter
    
31.         End With
    
32.     End With
    
33.     Set d = Nothing
    
34.     MsgBox "OK！"
    
35. End Sub
    

复制代码

ykcbf1100

附件供参考。。。

vicio

ykcbf1100 发表于 2024-1-19 13:02
附件供参考。。。

请问方便私聊吗？

ykcbf1100

vicio 发表于 2024-1-19 13:36
请问方便私聊吗？

加我QQ号。

shiruiqiang