ª««~¤ÀÃþ

sillykin

¬O§_¯à¨Ìª««~¤U¥h¤ÀÃþ?

jcchiang

¦^´_ 1# sillykin

¸Õ¸Õ¬Ý
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
With Target
   If .Row = 1 And .Column = 9 Then
      Range([j2], [j2].End(4)).ClearContents
      If .Value <> "" Then
         Set a = Range([c1], [c1].End(2)).Find([I1], , , xlWhole)
         For Each b In Range(Range(a.Address), Range(a.Address).Resize(Range("a1").End(4).Row))
            If b = 1 Then d.Add b.Offset(, 2 - b.Column), ""
         Next
         [j2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
         Set d = Nothing
      Else: Exit Sub
      End If
   End If
End With
End Sub

hcm19522

https://blog.xuite.net/hcm19522/twblog/589303177

­ã´£³¡ªL

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


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

sillykin

¦^´_ 4# ­ã´£³¡ªL
·PÁ¤j¤jªº¦^ÂÐ...
¦ýÁÙ¦³¤@­Ó¤p°ÝÃD,¬O§_¯àÀ°¸Ñ¨M,¦pªG­n¥X²{¤GºØ,¬O§_¯à¨Ì¿ï¾ÜºØÃþ,¦C¥Xª««~¦WºÙ

sillykin

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
¦ý¸Õ¹L°µ¤G­Ó¤W­z¤À§O°õ¦æ¡A¤èªk¥i¦æ¡A¦ý¬O§_¯à¤@¦¸©Ê°õ¦æ©Î²³æ¤è¦¡©O¡H

­ã´£³¡ªL

¦^´_ 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


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