求助大神 ，求不同日期段平均价和购入平均价

dnvjfdeuff

全党 发表于 2024-5-22 06:52

大神好了，下面的楼主已解决

dnvjfdeuff

全党 发表于 2024-5-22 06:52

谢谢大神，太厉害了

ykcbf1100

参与一下。。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.22
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("Sheet1")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[a1].Resize(r, 11)
   
7.         For i = 2 To UBound(arr)
   
8.             s = arr(i, 1)
   
9.             For j = 2 To 6
   
10.                 s = s & "|" & arr(i, j)
    
11.             Next
    
12.             If Not d.exists(s) Then
    
13.                 d(s) = Array(1, arr(i, 8), arr(i, 11))
    
14.             Else
    
15.                 t = d(s)
    
16.                 t(0) = t(0) + 1
    
17.                 t(1) = t(1) + arr(i, 8)
    
18.                 t(2) = t(2) + arr(i, 11)
    
19.                 d(s) = t
    
20.             End If
    
21.         Next
    
22.         ReDim brr(1 To d.Count, 1 To 9)
    
23.         For Each k In d.keys
    
24.             m = m + 1
    
25.             b = Split(k, "|")
    
26.             For x = 1 To 6
    
27.                 brr(m, x) = b(x - 1)
    
28.             Next
    
29.             brr(m, 7) = Application.WorksheetFunction.Round(d(k)(1) / d(k)(0), 2)
    
30.             brr(m, 8) = d(k)(2)
    
31.             brr(m, 9) = brr(m, 7) - brr(m, 8)
    
32.         Next
    
33.         .[o2:w1000] = ""
    
34.         .[o2].Resize(m, 9) = brr
    
35.         .[o2].Resize(m, 9).Borders.LineStyle = 1
    
36.     End With
    
37.     Application.ScreenUpdating = False
    
38.     MsgBox "OK！"
    
39. End Sub
    
40. 
    

复制代码

dnvjfdeuff

ykcbf1100 发表于 2024-5-22 09:27
参与一下。。。

谢谢大神，已解决解决