返回列表 上一主題 發帖

物品分類

Sub TEST()
Dim Arr, R&, C&, T$, N&
[J2:J6000].ClearContents
T = [i1]: If T = "" Then Exit Sub
Arr = Range([F1], [B65536].End(xlUp))
For C = 2 To UBound(Arr, 2)
    If Arr(1, C) <> T Then GoTo c01
For R = 2 To UBound(Arr)
    If Val(Arr(R, C)) > 0 Then N = N + 1: Arr(N, 1) = Arr(R, 1)
Next R
c01: Next C
If N > 0 Then [j2].Resize(N) = Arr
End Sub


'=============================

TOP

回復 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


'=========================

TOP

回復 8# sillykin

instr 及 公式的 find 用法類似

msgbox instr("ACFT", "A") '--- =1
msgbox instr("_ACFT", "A") '--- =2
msgbox instr("_BACT", "")  '--- = 1

加 "_", 避免空字符返回1的誤判

TOP

        靜思自在 : 要用心,不要操心、煩心。
返回列表 上一主題