ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] excel VBA ¦Û°Ê§ó·s¿z¿ï°ÝÃD

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   If .Column = 32 And .Row >= 2 And .Count = 1 Then
      If ActiveSheet.FilterMode = True Then
         If .Value <> "¾÷¥x²§±`" Then
            .Rows(.Count).EntireRow.Hidden = True
         End If
      End If
   End If
End With
End Sub

°Ñ¦Ò!
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 3# jsc0518


2­Ó¥H¤U¿z¿ï¨ú®ø¶µ¦³®Ä
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   Dim Qx$, Af&, Sc$, i&
   Af = 32
   Sc = ""
   Qx = ""
   If .Column = Af And .Row >= 2 And .Count = 1 Then
      If ActiveSheet.FilterMode = True Then
         For i = 2 To ActiveSheet.UsedRange.Rows.Count
            If Rows(i).EntireRow.Hidden = True Then
               If Sc = "" Then
                  Sc = Cells(i, "AF")
               End If
               If Qx = "" And Cells(i, "AF") <> Sc Then
                  Qx = Cells(i, "AF")
               End If
               If InStr(Sc & "," & Qx, Cells(i, "AF")) = 0 Then
                  GoTo 99
               End If
            End If
         Next
         Selection.AutoFilter Field:=Af, Criteria1:="<>" & Sc, Operator:=xlAnd, Criteria2:="<>" & Qx
         ActiveSheet.AutoFilter.ApplyFilter
         
99
      End If
   End If
End With
End Sub

°Ñ¦Ò!
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 6# jsc0518


1.¦pªG¥i¥H¥Î! ¥Nªí¤è¦V¹ï¤F!
2.Andy¾Ç«Ü¤[¤F!¶i¨B«ÜºC!³o¬O¥Î¤g¤èªk«÷´ê¥X¨Óªº
2.1.¥u¬O¥Î°j°é§PÂ_¿z¿ï«áÁôÂäF¤°»ò¶µ¥Ø
2.2.¦pªG¿z¿ï«áÁôÂöW¹L¨â¶µ´N¤£¾A¥Î!
      ¦pªG¨â¶µ¥H¤U´N¥H¦Û­q¿z¿ïªº¤è¦¡¨ú¥N¨ú®ø¤Ä¿ïªº¿z¿ï
3.À³¸Ó¦³§ó°ª©úªº¤èªk! ½Ð°ª¤â«e½ú­Ì«ü¾É!
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 6# jsc0518


¿z¿ï1~5­Ó¶µ¥Ø§¡¾A¥Î
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   Dim Qx$, Af&, Sh$, S1$, S2$, S3$, S4$, S5$, i&
   Af = 32
   Sh = ""
   S1 = ""
   S2 = ""
   S3 = ""
   S4 = ""
   S5 = ""
   If .Column = Af And .Row >= 2 And .Count = 1 Then
      If ActiveSheet.FilterMode = True Then
         For i = 2 To ActiveSheet.UsedRange.Rows.Count
            If Rows(i).EntireRow.Hidden = True Then
               If Sh = "" Then
                  Sh = Cells(i, "AF")
                  ElseIf InStr(Sh, Cells(i, "AF")) = 0 Then
                     Sh = Sh & "," & Cells(i, "AF")
               End If
               ElseIf InStr(Sh, Cells(i, "AF")) <> 0 Then
                  GoTo 999
               ElseIf S1 = "" Then
                  S1 = Cells(i, "AF")
               ElseIf S2 = "" And InStr(S1, Cells(i, "AF")) = 0 Then
                  S2 = Cells(i, "AF")
               ElseIf S3 = "" And InStr(S1 & S2, Cells(i, "AF")) = 0 Then
                  S3 = Cells(i, "AF")
               ElseIf S4 = "" And InStr(S1 & S2 & S3, Cells(i, "AF")) = 0 Then
                  S4 = Cells(i, "AF")
               ElseIf S5 = "" And InStr(S1 & S2 & S3 & S4, Cells(i, "AF")) = 0 Then
                  S5 = Cells(i, "AF")
                  Exit For
            End If
            
999
         Next
         If InStr(Sh, .Value) <> 0 Then
            .Rows(.Count).EntireRow.Hidden = True
            Else
               Selection.AutoFilter Field:=Af, Criteria1:=Array( _
                  S1, S2, S3, S4, S5), Operator:=xlFilterValues
               ActiveSheet.AutoFilter.ApplyFilter
         End If
      End If
   End If
End With
End Sub

°Ñ¦Ò!
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 10# jsc0518


ElseIf InStr(Sh, Cells(i, "AF")) <> 0 Then
     GoTo 999
¦pªGÀx¦s®æCells(i, "AF")¬OÅã¥Üªº¥B¦bÁôÂêºÀx¦s®æ¸Ì¦³
´N¸õ¨ì 999Ä~Äò°õ¦æ
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 11# jsc0518


    «á­±¦³Ãö«Y¨ì¶µ¥Øªº³£­nÃþ±ÀEX:
ElseIf S6 = "" And InStr(S1 & S2 & S3 & S4 & S5, Cells(i, "AF")) = 0 Then
   S6 = Cells(i, "AF")
~~~

¦h¸Õ´X¦¸´N·|¤F!
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 11# jsc0518


    À³¸Ó¥i¥H³]­p¤£­­¨î¶µ¥Ø¼Æ¶q!
¦ý§Ú¤£·|! ÀR«Ý°ª¤â«ü¾É!
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 16# jsc0518


    '¬ã¨s¤F3­Ó©«¤l«÷´ê¥X¤F ¤£­­¶µ¥Ø¼Æ¶qªº¤èªk
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   Dim Af&, Sh$, i&, Arr(), Brr(), K&, Dic As Object
   Set Dic = CreateObject("scripting.dictionary")
   Af = 32
   If .Column = Af And .Row >= 2 And .Count = 1 Then
      If ActiveSheet.FilterMode = True Then
         Arr = Range("AF2:AF" & ActiveSheet.UsedRange.Rows.Count)
         ReDim Brr(1 To UBound(Arr), 1 To 1)
         For i = 1 To UBound(Arr)
            If Rows(i).EntireRow.Hidden = True Then
               If Sh = "" Then
                  Sh = Cells(i, "AF")
                  ElseIf InStr(Sh, Cells(i, "AF")) = 0 Then
                     Sh = Sh & "," & Cells(i, "AF")
               End If
               ElseIf InStr(Sh, Cells(i, "AF")) <> 0 Then
                  GoTo 999
               ElseIf Dic.exists(Arr(i, 1)) Then
                  Dic(Arr(i, 1)) = ""
                  K = K + 1
                  Brr(K, 1) = Arr(i, 1)
            End If
            
999
         Next
         If InStr(Sh, .Value) <> 0 Then
            .Rows(.Count).EntireRow.Hidden = True
            ElseIf K > 0 Then
               Selection.AutoFilter Field:=Af, Criteria1:=Brr, Operator:=xlFilterValues
               ActiveSheet.AutoFilter.ApplyFilter
         End If
      End If
   End If
End With
End Sub
'²q´ú¥Í²£¬yµ{¬O «Ý®Æ>«Ý¥Í²£>¥Í²£¤¤>µ²§å  ¯S®íª¬ªp ¾÷¥x²§±`or¼È°± ¥H¤U¸gÅç¨Ñ°Ñ¦Ò
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
   '¦bAFÄæÀx¦s®æ¥H·Æ¹«¥ªÁä§Ö«ö¨â¦¸>>¨Ì·Ó¬yµ{ §ïÅܬyµ{¶i«×
   If .Column = 32 And .Row >= 2 Then
      If .Value = "«Ý®Æ" Then
         .Value = "«Ý¥Í²£"
         ElseIf .Value = "«Ý¥Í²£" Then
            .Value = "¥Í²£¤¤"
         ElseIf .Value = "¥Í²£¤¤" Then
            .Value = "µ²§å"
         ElseIf .Value = "µ²§å" Then
            MsgBox "?"
         ElseIf .Value = "¾÷¥x²§±`" Then
            .Value = "¥Í²£¤¤"
         ElseIf .Value = "¼È°±" Then
            .Value = "¥Í²£¤¤"
      End If
      Cancel = True
   End If
   '¦bAGÄæÀx¦s®æ¥H·Æ¹«¥ªÁä§Ö«ö¨â¦¸>>§ïÅܬyµ{¯S§Oª¬ªp(¾÷¥x²§±`)
   If .Column = 33 And .Row >= 2 Then
      If .Cells(1, 0) = "¥Í²£¤¤" Then
         .Cells(1, 0) = "¾÷¥x²§±`"
      End If
      Cancel = True
   End If
   '¦bAF1Àx¦s®æ¥H·Æ¹«¥ªÁä§Ö«ö¨â¦¸>>¸Ñ°£¥þ³¡Äæ¦ì¿z¿ï
   If .Address = "$AF$1" Then
      If ActiveSheet.FilterMode = True Then
         ActiveSheet.ShowAllData
      End If
      Cancel = True
   End If
End With
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
With Target
   '¦bAFÄæÀx¦s®æ«ö·Æ¹«¥kÁä>>ª½±µÀ°¦bAFÄæ¿z¿ï·í®æªº¶µ¥Ø
   'EX: ¦b¨S¦³¿z¿ïªº±¡ªp¤U ¦bAF2Àx¦s®æ«ö·Æ¹«¥kÁä,¦pªGAF2ªº¤å¦r¬O "¥Í²£¤¤" ´NÀ°¦bAFÄæ¿z¿ï "¥Í²£¤¤"
   If .Column = 32 And .Row >= 2 And .Count = 1 Then
      If ActiveSheet.FilterMode = True Then
         ActiveSheet.ShowAllData
      End If
      Selection.AutoFilter Field:=32, Criteria1:=.Value, Operator:=xlFilterValues
      Cancel = True
   End If
   '¦bAGÄæÀx¦s®æ«ö·Æ¹«¥kÁä>>§ïÅܬyµ{¯S§Oª¬ªp(¼È°±)
   If .Column = 33 And .Row >= 2 Then
      If .Cells(1, 0) = "¥Í²£¤¤" Then
         .Cells(1, 0) = "¼È°±"
      End If
      Cancel = True
   End If
End With

°Ñ¦Ò!
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¤£¤@©w²y²y¬O¦n²y¡A¦ý¬O¦³¾ú½mªº±j¥´ªÌ¡AÀH®É³£¥i¥H´§´Î¡C
ªð¦^¦Cªí ¤W¤@¥DÃD