- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
2#
發表於 2023-10-20 10:30
| 只看該作者
本帖最後由 Andy2483 於 2023-10-20 12:57 編輯
回復 1# jomeow
謝謝前輩發表此主題與範例
後學藉此帖練習VBA陣列,練習方案如下,請前輩參考
Option Explicit
Sub TEST()
Dim Brr, Crr, v&, Q%, i&, j%, R&, c%, M&, A%, K&
K = 2000: Brr = Range([A1], ActiveSheet.UsedRange.Offset(1, 0))
ReDim Crr(1 To UBound(Brr), 1 To UBound(Brr, 2))
For j = 2 To UBound(Brr, 2)
c = c + 1: R = 0: Q = 0
If Brr(2, j) Like "BM *" = False Then Exit For
If Brr(3, j) = "" Then GoTo j01
For i = 3 To UBound(Brr)
v = v + Val(Brr(i, j)): A = A + 1
If Trim(Brr(i + 1, j)) = "" Then Q = 1
If (v = K And A > 1) + (v > K) + (Q = 1 And v > 0) < 0 Then
R = R + 1: Crr(R, c) = v: v = 0: A = 0
End If
If Q = 1 Then Exit For
Next
If M < R Then M = R
j01: Next
If M = 0 Then Exit Sub
[J:Z].ClearContents
[J1].Resize(M, c - 1) = Crr
Erase Brr, Crr
End Sub |
|
發表於 2023-10-21 09:52
| 
