求助：如何合并数据

Qs18

1. Sub qs()
   
2. Dim arr, i, dic, sht As Worksheet
   
3. Set dic = CreateObject("scripting.dictionary")
   
4. ReDim brr(1 To 1000, 1 To 20)
   
5. m = 1: n = 3
   
6. For Each sht In Sheets
   
7.     If sht.Name <> "总表" Then
   
8.         arr = sht.Range("a1").CurrentRegion.Value
   
9.         For i = 3 To UBound(arr)
   
10.             s = arr(i, 1): s2 = arr(1, 1)
    
11.             If Not dic.exists(s) Then
    
12.                 m = m + 1
    
13.                 dic(s) = m
    
14.                 brr(m, 1) = s
    
15.                 brr(m, 3) = arr(i, 3)
    
16.             Else
    
17.                 r = dic(s)
    
18.                 brr(r, 3) = brr(r, 3) + arr(i, 3)
    
19.             End If
    
20.             If Not dic.exists(s2) Then
    
21.                 n = n + 1
    
22.                 dic(s2) = n
    
23.                 brr(1, n) = s2
    
24.                 m1 = dic(s)
    
25.                 brr(m1, n) = brr(m1, n) + arr(i, 3)
    
26.             Else
    
27.                 n2 = dic(s2)
    
28.                 m2 = dic(s)
    
29.                 brr(m2, n2) = brr(m2, n2) + arr(i, 3)
    
30.             End If
    
31.         Next
    
32.     End If
    
33. Next
    
34. brr(1, 1) = "名字": brr(1, 2) = "规格": brr(1, 3) = "数量"
    
35. Sheet1.[a2].Resize(m, n) = brr
    
36. End Sub
    

复制代码

Qs18

试试.........

Qs18

试试..........

prowl

Qs18 发表于 2024-12-8 11:01
试试..........

太感谢老师了

yanglinzi

yanglinzi

是不是这样。。。

prowl

yanglinzi 发表于 2024-12-8 14:48
是不是这样。。。

感谢感谢老师