- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2025-1-10
|
2#
發表於 2021-11-18 13:12
| 只看該作者
回復 1# adrian_9832
請測試看看,謝謝
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 |
|