搞了两天也没有搞出来，求助大神

全党

吴中泉 发表于 2023-7-3 15:58
光说不练假把式

做了前三个问题，第四个觉得没啥实际意义，也简单没做。代码未经测试。

1. Sub shishi()
   
2. Dim brr
   
3. Set dic = CreateObject("scripting.dictionary")
   
4. arr = Sheet2.Range("a1").CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6. Key = arr(i, 1) & "|" & arr(i, 4)
   
7. If Not dic.exists(Key) Then
   
8. dic(Key) = i
   
9. Else
   
10. dic(Key) = dic(Key) & ";" & i
    
11. End If
    
12. Next
    
13. ReDim brr(1 To dic.Count, 1 To 5)
    
14. For Each Key In dic.keys
    
15. ss = Split(dic(Key), ";")
    
16. n1 = 0: n2 = 0: s = 0: s1 = 0: s2 = 0
    
17. For j = 0 To UBound(ss)
    
18.   If arr(ss(j), 5) = "血氧饱和度监测费" Or arr(ss(j), 5) = "指脉氧监测费" Then s = s + Val(arr(ss(j), 9))
    
19.   If arr(ss(j), 5) = "胃肠减压" Then n1 = n1 + 1: s1 = s1 + Val(arr(ss(j), 9))
    
20.   If arr(ss(j), 5) = "二级医院普通床位费" And arr(ss(j), 9) > 40 Then n2 = n2 + 1: s2 = s2 + Val(arr(ss(j), 9))
    
21.   Next
    
22.   n = n + 1
    
23.   brr(n, 1) = Split(Key, "|")(0): brr(n, 2) = Split(Key, "|")(1): brr(n, 3) = s
    
24.   If n1 > 1 Then brr(n, 4) = s1: If n2 > 1 Then brr(n, 5) = s2
    
25. 
    
26. Next
    
27. End Sub

复制代码

吴中泉

全党 发表于 2023-7-5 08:59
做了前三个问题，第四个觉得没啥实际意义，也简单没做。代码未经测试。

辛苦，既然做了还是要进行简单测试