多行数据汇总成单行数据

kort20034

如下图，我想把sheet2表的多行数据汇总成sheet1格式的单行数据，谢谢！

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.12.11
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     arr = Sheets("汇总").UsedRange
   
6.     For j = 3 To UBound(arr, 2)
   
7.         If arr(1, j) <> Empty Then st = arr(1, j)
   
8.         s = st & "|" & arr(3, j)
   
9.         d1(s) = j
   
10.     Next
    
11.     arr = Sheets("数据").UsedRange
    
12.     ReDim brr(1 To 10000, 1 To 100)
    
13.     For i = 3 To UBound(arr)
    
14.         If arr(i, 1) <> Empty Then
    
15.             s = arr(i, 1)
    
16.             If Not d.exists(s) Then
    
17.                 m = m + 1
    
18.                 d(s) = m
    
19.                 brr(m, 1) = arr(i, 1)
    
20.                 brr(m, 2) = arr(i, 2)
    
21.             End If
    
22.             r = d(arr(i, 1))
    
23.             For j = 4 To UBound(arr, 2) Step 2
    
24.                 s = arr(1, j) & "|" & arr(i, 3)
    
25.                 If d1.exists(s) Then c = d1(s)
    
26.                 brr(r, c) = brr(r, c) + arr(i, j + 1)
    
27.                 s = arr(1, j) & "|" & arr(2, j)
    
28.                 If d1.exists(s) Then c = d1(s)
    
29.                 brr(r, c) = arr(i, j)
    
30.             Next
    
31.         End If
    
32.     Next
    
33.     With Sheets("汇总")
    
34.         .UsedRange.Offset(3).ClearContents
    
35.         .[a4].Resize(m, 14) = brr
    
36.         ActiveWindow.DisplayZeros = False
    
37.     End With
    
38.     Set d = Nothing
    
39.     Set d1 = Nothing
    
40.     Application.ScreenUpdating = True
    
41.     MsgBox "OK！"
    
42. End Sub
    

复制代码

kort20034

。。。。。。。。。。

kort20034

。。。。。。。。。。。

deadzlq

PQ参考解法

kort20034

deadzlq 发表于 2024-12-11 16:29
PQ参考解法

谢谢，不过需要VBA处理，因为这只是局部的汇总

kort20034

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

谢谢，我更新了一下附件，现在这个格式23行和35行的代码不知道咋处理，可以麻烦再看一下应该咋改？

ykcbf1100

kort20034 发表于 2024-12-11 16:38
谢谢，我更新了一下附件，现在这个格式23行和35行的代码不知道咋处理，可以麻烦再看一下应该咋改？

哪来的２３行和３５行，数据表总共才２２行。

kort20034

ykcbf1100 发表于 2024-12-11 16:48
哪来的２３行和３５行，数据表总共才２２行。

不是，我说的是刚刚代码表上的行数，我更新了附件，就是按更新后附件的格式我修改了几遍代码没成功，