求计算后将数据引用到文本来

冰冰189

求计算后将数据引用到文本来，详见附件。

quqiyuan

供参考

冰冰189

quqiyuan 发表于 2024-5-16 19:40
供参考

谢谢老师非常正确

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf87()   '//2024.5.16
   
2.     Dim arr, brr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = Sheets("数据源").UsedRange
   
6.     ReDim brr(1 To UBound(arr), 1 To 7)
   
7.     On Error Resume Next
   
8.     For i = 2 To UBound(arr)
   
9.         If Val(arr(i, 1)) Then
   
10.             s = arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 8)
    
11.             If Not d.Exists(s) Then
    
12.                 m = m + 1
    
13.                 d(s) = m
    
14.                 brr(m, 1) = arr(i, 2)
    
15.                 brr(m, 2) = arr(i, 3)
    
16.                 brr(m, 3) = arr(i, 4)
    
17.                 brr(m, 4) = arr(i, 8)
    
18.             Else
    
19.                 r = d(s)
    
20.                 brr(r, 7) = brr(r, 7) + arr(i, 9) + arr(i, 10)
    
21.                 brr(r, 5) = brr(r, 5) + arr(i, 10)
    
22.                 brr(r, 6) = brr(r, 5) / brr(r, 7)
    
23.             End If
    
24.             
    
25.         End If
    
26.     Next
    
27.     With Sheets("统计")
    
28.         .UsedRange.Offset(3) = ""
    
29.         .Columns(6).NumberFormatLocal = "0.000%"
    
30.         .Range("a4").Resize(m, 6) = brr
    
31.         .Range("a4").Resize(m, 6).Borders.LineStyle = 1
    
32.     End With
    
33.     Set d = Nothing
    
34.     Application.ScreenUpdating = True
    
35.     MsgBox "OK！"
    
36. End Sub
    

复制代码

quqiyuan

冰冰189 发表于 2024-5-16 19:56
谢谢老师非常正确

目前你的数据都是连续的，上面的代码没有问题，如果不是连续的话，你修改一下，下面的不连续也可以的，比较通用一点，刚才失误了

冰冰189

quqiyuan 发表于 2024-5-16 20:10
目前你的数据都是连续的，上面的代码没有问题，如果不是连续的话，你修改一下，下面的不连续也可以的，比 ...

谢谢老师，谢谢的代码一目了然，易看清楚。

冰冰189

quqiyuan 发表于 2024-5-16 20:10
目前你的数据都是连续的，上面的代码没有问题，如果不是连续的话，你修改一下，下面的不连续也可以的，比 ...

老师有时间帮忙在修改一下代码，能否把数据都实际完成日期，引用到统计里面来，参考图，谢谢！

quqiyuan

冰冰189 发表于 2024-5-17 07:43
老师有时间帮忙在修改一下代码，能否把数据都实际完成日期，引用到统计里面来，参考图，谢谢！

冰冰189

quqiyuan 发表于 2024-5-17 08:12

谢谢老师，还有一点小问题，就是当EXCEL文本信息设置好后，重新按导入按钮，有的数据又要去重新设置格式。