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

[µo°Ý] VBA ·j´Mªº°ÝÃD

¦^´_ 18# ­ã´£³¡ªL

¸Õ¤F¤j¤jªº¤èªk¡A¦³­Ó°ÝÃD·Q°Ý¤@¤U
¡@¡@¡@.Sort Key1:=.Item(6), Order1:=xlAscending, Header:=xlYes, _
¡@¡@¡@¡@¡@¡@OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


§Ú³oÃä·Q¦Û­q·j¿ïªº±Æ§Ç "®à²y","¦Ð²y","®à²y","Äx²y"
§Ú¸Ó¦p¦ó¥[¤W¤W­z»yªk©O?

³Â·Ð¤F :$

¹Ï¤ù 16.png (9.6 KB)

¹Ï¤ù 16.png

TOP

¦^´_ 25# ­ã´£³¡ªL

«D±`·PÁ¨â¦ìªO¥Dªº¦^ÂÐ><

Sub ±Æ§Ç()
Dim R&, LRR, Lm%, Lx%
R = [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp).Row
If R < 4 Then Exit Sub
¡@
LRR = Split("ÂŲy_±Æ²y_´Î²y_¨¬²y_®à²y", "_") ¡@'±Æ§Ç²M³æ
With Application
¡@¡@¡@Lm = .GetCustomListNum(LRR) ¡@'Àˬd²M³æªº¦ì¸m
¡@¡@¡@If Lm = 0 Then .AddCustomList ListArray:=LRR ¡@'²M³æ¤£¦s¦b,«Ø¥ß
¡@¡@¡@Lx = .GetCustomListNum(LRR) ¡@'¨ú±o²M³æ¦ì¸m§Ç¸¹
End With
¡@
With [¤u§@ªí1!A3:F3].Resize(R - 2)
¡@¡@¡@.Select
¡@¡@¡@.Sort Key1:=.Item(6), Order1:=xlAscending, Header:=xlYes, _
¡@¡@¡@¡@¡@¡@OrderCustom:=Lx + 1, MatchCase:=False, Orientation:=xlTopToBottom
End With
¡@
If Lm = 0 Then Application.DeleteCustomList ListNum:=Lx ¡@'²M³æ­Y¬O¥»¦¸«Ø¥ß,§R°£²M³æ
End Sub



¨Ï¥Î¤F³o­Ó¤èªk½T¹ê¥i¥H¶¶§Qªº±Æ§Ç¡A
¦ý¥u­n«ö¤U¦sÀÉ¡A¾ã­ÓEXCEL ´N·|·í±¼¤F....
¬Ý¨Ó¦ü¥G¥u¯à¥ÎGBª©¤j ªº¤â°Ê¸ê®Æ±Æ§Ç¤F:Q

TOP

HI ¡Aª±¤@ª±¤W­zªº¤½¦¡¤S¦^¨Óµo°Ý¤F:P

1.
Sub ¿z¿ï()
    Dim X$
    X = Application.InputBox("½Ð¿é¤J¿z¿ïÃöÁä¦r")
    If X = "" Or X = "False" Then Exit Sub
    With Sheets("¤u§@ªí1").[A3]  '
        .Parent.AutoFilterMode = False
        
        .AutoFilter Field:=1, Criteria1:="*" & X & "*"
        If .End(xlDown).Row = Rows.Count Then MsgBox "§ä¤£¨ì¸ê®Æ!!": Exit Sub
        .CurrentRegion.Sort Key1:=.Range("C3"), Order1:=xlAscending, Header:=xlYes
    End With
End Sub

­ì¥»·j´Mªº¬O²Ä¤@Äæ ¯Z¯Å¡A­Y§Ú·Q·j´Mªº¬O²Ä¥|Äæ ©Ê§O
§Ú¸Ó¦p¦ó­×§ï©O? §Ú¼Æ¦r³£§ï¹L¤F><"


2.
Sub ·j´M()
Dim X$, R&, xSht As Worksheet, M, j&, Jm&, xH As Range
R = ActiveSheet.UsedRange.Rows.Count
If R > 5 Then Rows("6:" & R).Delete
X = Application.InputBox("½Ð¿é¤J·j´MÃöÁä¦r")
If X = "" Or X = "False" Then Exit Sub
For Each xSht In Sheets(Array("¤u§@ªí1", "¤u§@ªí3", "¤u§@ªí4"))
    Set xH = Range(Array("A6", "I6", "P6")(M))
    M = M + 1: Jm = 0
    With xSht
          For j = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
              If InStr(.Cells(j, 1) & .Cells(j, 2), X) Then
                  Jm = Jm + 1
                  .Cells(j, 1).Resize(1, 6).Copy xH(Jm)
              End If
          Next j
          If Jm = 0 Then MsgBox "¡e" & .Name & "¡f§ä¤£¨ì¡e" & X & "¡f¬ÛÃö¸ê®Æ!!":
         
    End With
Next
End Sub

¤u§@ªí2ªº·j´M ·Q¼W¥[¥t¤@ºØ¤è¦¡
¤£¨Ï¥ÎINPUTBOX ¡Aª½±µ§ï¦¨ Äx²y©Î±Æ²y ¨âºØµ²ªG³£·j´M¥X¨Ó
¸Ó¦p¦ó­×§ï©O


¦A³Â·Ð«ü±Ð¡A±Ð¾É¤F¡A·PÁ¦A·PÁÂ

¹Ï¤ù 4.png (9.78 KB)

¹Ï¤ù 4.png

TOP

        ÀR«ä¦Û¦b : ¦Y­W¤F­W¡B­WºÉ¤Ü¨Ó¡A¨ÉºÖ¤FºÖ¡BºÖºÉ´d¨Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD