根据表2B列内容从表1查找对应数据

他们

根据表2B列内容从表1查找对应数据

他们

请各位老师帮一帮小弟，在此先谢过了！

qline302

用【数据透视表】更适合你这种情况，看看附件是否是要结果。

shiruiqiang

如图，这样怎么计算？

他们

shiruiqiang 发表于 2024-1-15 22:20
如图，这样怎么计算？

C:\Users\286\Desktop

他们

想用VBA达到图片上这种计算效果C:\Users\286\Desktop

他们

用VBA达到图片上这种效果

ykcbf1100

数量1和数量2的公式不对吧，这个只能查到第一个记录的数量。

沈默00

应该有点问题吧，这么多数量，取哪一个？？

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.16
   
2.     Dim arr, brr, d
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Dim tm: tm = Timer
   
6.     Set d = CreateObject("Scripting.Dictionary")
   
7.     b = [{3,99,11,7,9,99,99,2,5,4,99}]
   
8.     With Sheets("Sheet1")
   
9.         r = .Cells(Rows.Count, 2).End(3).Row
   
10.         arr = .Range("b2:n" & r)
    
11.     End With
    
12.     For i = 2 To UBound(arr)
    
13.         s = arr(i, 3)
    
14.         If Not d.exists(s) Then
    
15.             d(s) = Array(1, arr(i, 11), arr(i, 7), arr(i, 9), arr(i, 7), arr(i, 9), arr(i, 2), arr(i, 5), arr(i, 4))
    
16.         Else
    
17.             t = d(s)
    
18.             t(0) = t(0) + 1
    
19.             t(3) = t(3) + arr(i, 7)
    
20.             t(4) = t(4) + arr(i, 9)
    
21.             d(s) = t
    
22.         End If
    
23.     Next
    
24.     With Sheets("Sheet2")
    
25.         r = .Cells(Rows.Count, 2).End(3).Row
    
26.         arr = .Range("b2:l" & r)
    
27.         For i = 2 To UBound(arr)
    
28.             s = arr(i, 1)
    
29.             If d.exists(s) Then
    
30.                 t = d(s)
    
31.                 For j = 2 To UBound(b) - 1
    
32.                     arr(i, j) = t(j - 2)
    
33.                 Next
    
34.                 arr(i, 11) = arr(i, 2) * arr(i, 3)
    
35.             End If
    
36.         Next
    
37.         .Range("b2:l" & r) = arr
    
38.     End With
    
39.     Set d = Nothing
    
40.     Application.ScreenUpdating = True
    
41.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
42. End Sub
    

复制代码