請測試看看，謝謝
Sub test()
Dim Arr, Brr(), i&, T%, T1,n%
Dim s1%, s2%, s3%, s4%, R%, C%
Arr = Range([a1], [c65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 5)
For i = 2 To UBound(Arr)
T = Arr(i, 2): T1 = Arr(i, 3)
If T >= 18 And T <= 30 Then
R = 1: s1 = s1 + 1
ElseIf T >= 31 And T <= 40 Then
R = 2: s2 = s2 + 1
ElseIf T >= 41 And T <= 50 Then
R = 3: s3 = s3 + 1
ElseIf T >= 51 And T <= 60 Then
R = 4: s4 = s4 + 1
End If
If T1 = 13.3 Then
C = 2
ElseIf T1 = 14 Then
C = 3
ElseIf T1 = 15.5 Then
C = 4
ElseIf T1 = 17.3 Then
C = 5
End If
If R > 0 And C > 0 Then
Brr(R, C) = IIf(Brr(R, C) = "", 1, Brr(R, C) + 1)
n = n + 1: R = 0: C = 0
End If
Next
Brr(1, 1) = s1: Brr(2, 1) = s2: Brr(3, 1) = s3: Brr(4, 1) = s4
Range("g2").Resize(n, 5) = Brr
End Sub作者: adrian_9832 時間: 2021-11-18 13:58
