- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2025-1-10
|
本帖最後由 samwang 於 2022-4-27 09:34 編輯
回復 1# oak0723-1
請測試看看，謝謝
Sub test()
Dim Arr, Brr(), i&, i2&
Arr = [a2].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 6)
For i = 2 To UBound(Arr)
If Trim(Arr(i, 1)) <> "" Then
Brr(i - 1, 1) = Arr(i, 1): Brr(i - 1, 2) = Arr(i, 2)
If Trim(Arr(i, 3)) <> "" Then Brr(i - 1, 3) = 1
If Trim(Arr(i, 5)) <> "" Then Brr(i - 1, 4) = 1
For i2 = i + 1 To UBound(Arr)
If Trim(Arr(i2, 1)) <> "" Then Exit For
If Trim(Arr(i2, 3)) <> "" Then Brr(i - 1, 3) = Brr(i - 1, 3) + 1
If Trim(Arr(i2, 5)) <> "" Then Brr(i - 1, 4) = Brr(i - 1, 4) + 1
Next
Brr(i - 1, 5) = Brr(i - 1, 2) / Brr(i - 1, 3)
Brr(i - 1, 6) = Brr(i - 1, 2) / Brr(i - 1, 4)
End If
Next
Range("L3").Resize(UBound(Brr), 6) = Brr
End Sub |
|
發表於 2022-4-27 09:33
| 