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

全党

字典嵌套可以解决

吴中泉

全党 发表于 2023-7-3 14:33
字典嵌套可以解决

光说不练假把式

于箱长

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

                     

于箱长

XIHAUA 发表于 2023-7-2 20:31
来瓶6.8的红牛就可以了，不然没力气干活

            

grf1973

有些收了又退了，可以看作是没收吧？

shinechou86

数据处理为什么不用pandas，以前两个需求为例，绝对代码量最低

吴中泉

吴中泉 发表于 2023-7-3 14:12
灵犀之声 发表于 2023-7-2 15:13
感谢大佬，能给附件吗？
有点烦了，应该可以优化的

1. Sub ssjss() 'wzq 2023.7.3
   
2. Dim arr, brr, d, i&, T
   
3. Set d = CreateObject("scripting.dictionary")
   
4. With Sheets("数据")
   
5.     r = .Cells(Rows.Count, 1).End(xlUp).Row
   
6.     arr = .Range("a1:i" & r)
   
7. End With
   
8. Sheet1.Activate
   
9. [a7:K60000] = ""
   
10. '问题一
    
11. For i = 2 To UBound(arr)
    
12.     If 0 < InStr(arr(i, 5), "血氧饱和度监测") Then
    
13.         T = arr(i, 1)
    
14.         If Not d.exists(T) Then
    
15.             d(T) = Array(arr(i, 9), 1, 0)
    
16.         Else
    
17.             d(T) = Array(d(T)(0) + arr(i, 9), d(T)(1) + 1, d(T)(2))
    
18.         End If
    
19.     End If
    
20.     If 0 < InStr(arr(i, 5), "指脉氧监测") Then
    
21.         T = arr(i, 1)
    
22.         If Not d.exists(T) Then
    
23.             d(T) = Array(arr(i, 9), 0, 1)
    
24.         Else
    
25.             d(T) = Array(d(T)(0) + arr(i, 9), d(T)(1), d(T)(2) + 1)
    
26.         End If
    
27.     End If
    
28. Next
    
29. ReDim brr(1 To d.Count, 1 To 2)
    
30. i = 0
    
31. If d.Count > 0 Then
    
32.     For Each T In d.keys
    
33.         If d(T)(1) > 0 And d(T)(2) > 0 Then
    
34.             i = i + 1
    
35.             brr(i, 1) = T
    
36.             brr(i, 2) = d(T)(0)
    
37.         End If
    
38.     Next
    
39.     Sheet1.[A7].Resize(d.Count, 2) = brr
    
40. End If
    
41. d.RemoveAll
    
42. '问题二
    
43. For i = 2 To UBound(arr)
    
44.     If 0 < InStr(arr(i, 5), "胃肠减压") Then
    
45.         T = arr(i, 1) & "|" & arr(i, 4)
    
46.         If Not d.exists(T) Then
    
47.             d(T) = Array(1, arr(i, 9))
    
48.         Else
    
49.             d(T) = Array(d(T)(0) + 1, d(T)(1) + arr(i, 9))
    
50.         End If
    
51.     End If
    
52. Next
    
53. ReDim brr(1 To d.Count, 1 To 2)
    
54. i = 0
    
55. If d.Count > 0 Then
    
56.     For Each T In d.keys
    
57.         If d(T)(0) > 1 Then
    
58.             i = i + 1
    
59.             brr(i, 1) = Split(T, "|")(0)
    
60.             brr(i, 2) = d(T)(1)
    
61.         End If
    
62.     Next
    
63.     Sheet1.[d7].Resize(d.Count, 2) = brr
    
64. End If
    
65. d.RemoveAll
    
66. '问题三
    
67. For i = 2 To UBound(arr)
    
68.     If 0 < InStr(arr(i, 5), "二级医院普通床位费") And arr(i, 7) > 40 Then
    
69.         T = arr(i, 1) & " " & arr(i, 4)
    
70.         If Not d.exists(T) Then
    
71.             d(T) = Array(1, arr(i, 9))
    
72.         Else
    
73.             d(T) = Array(d(T)(0) + 1, d(T)(1) + arr(i, 9))
    
74.         End If
    
75.     End If
    
76. Next
    
77. ReDim brr(1 To d.Count, 1 To 2)
    
78. i = 0
    
79. If d.Count > 0 Then
    
80.     For Each T In d.keys
    
81.         If d(T)(0) > 1 Then
    
82.             i = i + 1
    
83.             brr(i, 1) = T 'Split(T, " ")(0)
    
84.             brr(i, 2) = d(T)(1)
    
85.         End If
    
86.     Next
    
87.     Sheet1.[G7].Resize(d.Count, 2) = brr
    
88. End If
    
89. d.RemoveAll
    
90. '问题四
    
91. Dim tian As Integer
    
92. For i = 2 To UBound(arr)
    
93.         T = arr(i, 1)
    
94.         If Not d.exists(T) Then
    
95.             tian = arr(i, 3) - arr(i, 2)
    
96.             d(T) = Array(1, arr(i, 9), tian)
    
97.         Else
    
98.             d(T) = Array(d(T)(0) + 1, d(T)(1) + arr(i, 9), d(T)(2))
    
99.         End If
    
100. Next
     
101. ReDim brr(1 To d.Count, 1 To 2)
     
102. i = 0
     
103. If d.Count > 0 Then
     
104.     For Each T In d.keys
     
105.         If d(T)(0) > d(T)(2) Then
     
106.             i = i + 1
     
107.             brr(i, 1) = T
     
108.             brr(i, 2) = d(T)(1)
     
109.         End If
     
110.     Next
     
111.     Sheet1.[J7].Resize(d.Count, 2) = brr
     
112. End If
     
113. 
     
114. End Sub
     

复制代码

全党

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

时间问题，明天有时间弄一下

1121228509

shiruiqiang

负的算退费，可以减去。就是第4点，收费总次数超过住院的天数，这个不一定准确。如糖尿病患者1天4次测血糖监测血糖，加起来一定超过