- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-7-25
|
回復 6# sillykin
Sub TEST()
Dim Arr, Brr, R&, Rn&, C&, Cn&, T$, N&
[J2:N6000].ClearContents
T = [i1]: If T = "" Then Exit Sub
Arr = Range([F1], [B65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To UBound(Arr, 2))
For C = 2 To UBound(Arr, 2)
If InStr("_" & T, Arr(1, C)) < 2 Then GoTo c01
Cn = Cn + 1: Rn = 0
For R = 2 To UBound(Arr)
If Val(Arr(R, C)) > 0 Then
Rn = Rn + 1: Brr(Rn, Cn) = Arr(R, 1)
If Rn > N Then N = Rn
End If
Next R
c01: Next C
If N > 0 Then [j2].Resize(N, Cn) = Brr
End Sub
'========================= |
|