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

sss1159

HI¡A¤j®a¦n

¦bºô¸ô¤Wª¦¤F¤@¬q®É¶¡¡A´ú¤F¦hºØªº°µªkÁÙ¬O¨S§ä¨ì²z·Qªº¤è¦¡
¦b¦¹¸ß°Ý¤@¤U¦U¦ì¤j¤j

¦³2­Ó¤u§@ªí
¤u§@ªí1 = ¦s©ñ¦UºØ¸ê®Æªº¦a¤è
¤u§@ªí2 = ·j´M°Ï

³oÃä»Ý­n2ºØ¤è¦¡:
1.
¦b¤u§@ªí2 ·j´M°Ï ¿é¤J­n·j´Mªº¸ê®Æ¡i¥Ò¡j
§Y¥iÅã¥Ü ¦³Ãö©ó¡i¥Ò¡jªº©Ò¦³¸ê®Æ

2.
¦b¤u§@ªí1 ÂI¿ï·j´M
·|¸õ¥X¼uµ¡ ¿é¤J¡i¥Ò¡j
´N·|¦b¤u§@ªí1 Åã¥Ü©Ò¦³Ãö©ó ¯Z¯Å¡i¥Ò¡jªº¸ê®Æ

¦bÂI¿ï «ö¶s¨ú®ø·j´M §Y¥i«ì´_¦¨­ì¨Óªº©Ò¦³¸ê®Æ


¦b³Â·Ð¦U¦ì¤j¤j±Ð¾É¡AÁÂÁÂ

yen956

¸Õ¸Õ¬Ý:
Q1:

1. Private Sub CommandButton1_Click()
   
2.     Dim sCel As Range
   
3.     Dim inTxt, First1 As String
   
4.     Dim LastRow As Long
   
5.     Range("K2:N" & Rows.Count & "").ClearContents    '²M°£¥ý«e·j´Mªº¸ê®Æ"
   
6.     inTxt = InputBox("½Ð¿é¤J·j´M¯Z¯Å", "·j´M¯Z¯Å")
   
7.     If inTxt = "" Then Exit Sub                      '­Y¨Ï¥ÎªÌ«ö [¨ú®ø] «hÂ÷¶}
   
8.     Set sCel = [A:A].Find(What:=inTxt, LookAt:=xlWhole)
   
9.     If sCel Is Nothing Then
   
10.         MsgBox ("¥¼§ä¨ì§A­n·j´Mªº¯Z¯Å"), vbCritical
    
11.         Exit Sub
    
12.     End If
    
13.     First1 = sCel.Address                       '«O¯d²Ä¤@­Ó·j´M¨ìªº¦ì§}
    
14.     Do
    
15.         LastRow = Cells(Rows.Count, 11).End(xlUp).Row + 1
    
16.         sCel.Resize(1, 4).Copy Cells(LastRow, 11)
    
17.         Set sCel = [A:A].FindNext(sCel)        '´M§ä¤U¤@­Ó
    
18.     Loop Until First1 = sCel.Address            '¤U¤@­Óªº¦ì¸m=²Ä¤@­Óªº¦ì¸m(¦^¨ì²Ä¤@­Óªº¦ì¸m)
    
19. End Sub

½Æ»s¥N½X

Q2:

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim sh1, sh2 As Object
   
3.     Dim sCel As Range
   
4.     Dim First1 As String
   
5.     Dim LastRow As Long
   
6.     Set sh1 = Sheets("¤u§@ªí1")
   
7.     Set sh2 = Sheets("¤u§@ªí2")
   
8.     If Intersect(Target, sh2.[I1]) Is Nothing Then Exit Sub
   
9.     If Target = "" Then Exit Sub
   
10.     sh2.Range("H4:K" & sh2.Rows.Count & "").ClearContents    '²M°£¥ý«e·j´Mªº¸ê®Æ"
    
11.     sh1.Activate
    
12.     With sh1
    
13.         Set sCel = .[A:B].Find(What:=Target, LookAt:=xlPart)
    
14.         If sCel Is Nothing Then
    
15.             MsgBox ("¥¼§ä¨ì§A­n·j´Mªº¸ê®Æ"), vbCritical
    
16.             Exit Sub
    
17.         End If
    
18.         First1 = sCel.Address                          '«O¯d²Ä¤@­Ó·j´M¨ìªº¦ì§}
    
19.         Do
    
20.             LastRow = sh2.Cells(sh2.Rows.Count, 8).End(xlUp).Row + 1
    
21.             sCel.Resize(1, 4).Copy sh2.Cells(LastRow, 8)
    
22.             Set sCel = .[A:B].FindNext(sCel)           '´M§ä¤U¤@­Ó
    
23.         Loop Until First1 = sCel.Address               '¤U¤@­Óªº¦ì¸m=²Ä¤@­Óªº¦ì¸m(¦^¨ì²Ä¤@­Óªº¦ì¸m)
    
24.     End With
    
25.     sh2.Activate
    
26. End Sub

½Æ»s¥N½X

sss1159

©êºp¡A³o¶g¥½¤£¦b®a¡A«Ü±ß¤~¦^Âбz
«D±`·PÁÂ yen956 ¤j¤j


¥t¥~·Q¦A½Ð°Ý
1.
¤u§@ªí1 ÂI¿ï·j´M ¥Ò
§Y¥i¦b¦¹¤u§@ªí ª½±µ¦C¥X ¯Z¯Å¥Òªº©Ò¦³¸ê®Æ

¦AÂI¿ï ¨ú®ø·j´M
§Y¥i«ì´_­ì¥»¥¼·j´M«eªº¸ê®Æ

2.
®M¥Î¤j¤j­Ó¤èªk
§Ú¥Ø«e¥d¦í¤F....¥Ø«e¦h¤F¤@­Ó¤u§@ªí3
¦b¤u§@ªí2·Q·j´M­­©w½d³ò
·j´M ¥Ò
A~DÄæ ·|Åã¥Ü¤u§@ªí1 ¥Òªº·j´M¤º®e
H~KÄæ ·|Åã¥Ü¤u§@ªí3 ¥Òªº·j´M¤º®e

3.
¦pªG ·j´M«ö¶s§ä¤£¨ì¸ê®Æ¡A­n¦b­þ¥´¤W [©êºp¡A§ä¤£¨ì¸ê®Æ] ªº»yªk©O



³Â·Ð½Ð«ü±Ð¡A¸U¤À·PÁÂ

sss1159

°Ú°Ú°Ú><
¤p©f·d¿ù¤F...¤W¤@«h¦^ÂÐ ¬O¥Î¥t¤@­Ó¤èªk....

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sh1, sh2 As Object
    Dim sCel As Range
    Dim First1 As String
    Dim LastRow As Long
    Set sh1 = Sheets("¤u§@ªí1")
    Set sh2 = Sheets("¤u§@ªí2")
    If Intersect(Target, sh2.[I1]) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    sh2.Range("H4:K" & sh2.Rows.Count & "").ClearContents    '²M°£¥ý«e·j´Mªº¸ê®Æ"
    sh1.Activate
    With sh1
        Set sCel = .[A:B].Find(What:=Target, LookAt:=xlPart)
        If sCel Is Nothing Then
            MsgBox ("¥¼§ä¨ì§A­n·j´Mªº¸ê®Æ"), vbCritical
            Exit Sub
        End If
        First1 = sCel.Address                          '«O¯d²Ä¤@­Ó·j´M¨ìªº¦ì§}
        Do
            LastRow = sh2.Cells(sh2.Rows.Count, 8).End(xlUp).Row + 1
            sCel.Resize(1, 4).Copy sh2.Cells(LastRow, 8)
            Set sCel = .[A:B].FindNext(sCel)           '´M§ä¤U¤@­Ó
        Loop Until First1 = sCel.Address               '¤U¤@­Óªº¦ì¸m=²Ä¤@­Óªº¦ì¸m(¦^¨ì²Ä¤@­Óªº¦ì¸m)
    End With
    sh2.Activate
End Sub

·Q½Ð°Ý³o¬q¸Ó«ç»ò¨Ï¥Î©O..¤£ª¾¹D¬°¬Æ»ò¨S¦³¥¨¶°

Set sCel = [A:A].Find(What:=inTxt, LookAt:=xlWhole)

³o¬q¸Ó«ç»ò¥h§ì¥t¤@­Ó¤u§@ªí©O?

­ã´£³¡ªL

¦^´_ 3# sss1159


¡e¤u§@ªí¢°¡f
¦AÂI¿ï ¨ú®ø·j´M
§Y¥i«ì´_­ì¥»¥¼·j´M«eªº¸ê®Æ

¢Ï¡G¢ÒÄæ§Y¬O­ì¥»¸ê®Æ¡A·j´M¨Ã¥¼°Ê¨ì¦¹³¡¥÷¡A¦ó¨Ó¡e«ì´_­ì¥»¥¼·j´M«eªº¸ê®Æ¡f¡H¡H¡H

sss1159

­ã´£³¡ªL ¤j¤j±z¦n

¡e¤u§@ªí¢°¡f
¦AÂI¿ï ¨ú®ø·j´M
§Y¥i«ì´_­ì¥»¥¼·j´M«eªº¸ê®Æ

¢Ï¡G¢ÒÄæ§Y¬O­ì¥»¸ê®Æ¡A·j´M¨Ã¥¼°Ê¨ì¦¹³¡¥÷¡A¦ó¨Ó¡e«ì´_­ì¥»¥¼·j´M«eªº¸ê®Æ¡f¡H¡H¡H

³o¤è­±¬O§Ú´y­zªº¤£¦n¡A¦b¤u§@ªí1¤¤¡AA:DÄæ ¬°¸ê®Æ°Ï
·í§ÚÂIÀ» ·j´M-> ¥Ò ·|±N¸ê®Æ¶ë¿ï¦¨ ©Ò¦³Ãö©ó ¯Z¯Å¥Òªº¸ê®Æ(·|Åã¥Ü¦bA:DÄæ)
·í§Ú¬d§¹¯Z¯Å¥Òªº¸ê®Æ«á¡AÂI¿ï ¨ú®ø·j´M §Y¥i«ì´_­ì¥»¥¼·j´M«eªº¸ê®Æ(¤@¼Ë¦bA:DÄæ)

¦A³Â·Ð«ü±Ð¤F¡A¸U¤À·PÁÂ:$

­ã´£³¡ªL

¦^´_ 6# sss1159


Sub ¿z¿ï()
Dim X$
X = Application.InputBox("½Ð¿é¤J¿z¿ïÃöÁä¦r")
If X = "" Or X = "False" Then Exit Sub
With Range([A3], Cells(Rows.Count, 1).End(xlUp))
     If .Offset(1, 0).Find(X, Lookat:=xlPart) Is Nothing Then MsgBox "§ä¤£¨ì¸ê®Æ!!": Exit Sub
    .AutoFilter Field:=1, Criteria1:="*" & X & "*"
End With
End Sub

'¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×
Sub ¿z¿ï¸Ñ°£()
ActiveSheet.AutoFilterMode = False
End Sub

­ã´£³¡ªL

¡Õ¤u§@ªí¢±¡Ö¡@

Sub ·j´M()
Dim X$, R&, xSht As Worksheet, M, j&, Jm&, xH As Range
R = ActiveSheet.UsedRange.Rows.Count
If R > 3 Then Rows("4:" & 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"))
¡@¡@Set xH = Range(Array("A4", "H4")(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, 4).Copy xH(Jm)
¡@¡@¡@¡@¡@¡@¡@End If
¡@¡@¡@¡@¡@Next j
¡@¡@¡@¡@¡@If Jm = 0 Then MsgBox "¡e" & .Name & "¡f§ä¤£¨ì¡e" & X & "¡f¬ÛÃö¸ê®Æ!!":
¡@¡@End With
Next
End Sub

sss1159

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

¹ê¦b¬O¤Ó·PÁ±z¤F
·Q½Ð±Ð±z³o»yªkªº·N«ä¬O...¬Ý¤£¤ÓÀ´

1.

R = ActiveSheet.UsedRange.Rows.Count
If R > 3 Then Rows("4:" & R).Delete

³o¬q¬O¦b ¤u§@ªí2 ºâ§Úªí®æ«e­±¯d¤F¦h¤Ö¦C¶Ü?
¦pªG§Ú¼ÐÃD¦b¦æ6 ´N§ï¦¨ R>6 ¬O³o¼Ë²z¸Ñ¶Ü?
«á­±ªº4¬O·j´M¥X¨Ó ¸ê®ÆÅã¥Üªº°_©lÄæ¦ì¶Ü?

2.

For Each xSht In Sheets(Array("¤u§@ªí1", "¤u§@ªí3"))
¡@¡@Set xH = Range(Array("A4", "H4")(M))

¦pªG §ÚÁÙ¦³ ¤u§@ªí4 ¤u§@ªí5
ª½±µ§ï¦¨
For Each xSht In Sheets(Array("¤u§@ªí1", "¤u§@ªí3","¤u§@ªí4", "¤u§@ªí5"))
¡@¡@Set xH = Range(Array("A4", "H4","O4", "U4")(M))
¥H¦¹Ãþ±À....??

3.

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, 4).Copy xH(Jm)
¡@¡@¡@¡@¡@¡@¡@End If

³o¬qªº4 ­n¸ò¤W­±ªº

R > 3 Then Rows("4:" & R).Delete

¤@¼Ë¤~¯à¨Ï¥Î ¬O³o¼Ë§a?


¦A³Â·Ð±z«ü±Ð¤U¡A«D±`·PÁ¡A§V¤O¾Ç²ß¤¤:$

­ã´£³¡ªL

¦^´_ 9# sss1159


R = Range([A1], ActiveSheet.UsedRange).Rows.Count
¡Ä½Ð§ï¦¨¦p¤W¡A¥H¨¾¡e¼ÐÃD¦C¡f¥H¤W¥¼¨Ï¥Î¡AUsedRange·|¤£¥]²[³o½d³ò
If R > 3 Then Rows("4:" & R).Delete
¡Ä¡e¼ÐÃD¦C¡f¦b²Ä¢²¦C¡A­Y¶W¹L¢²¤~ªí¥Ü©³¤U¦³¸ê®Æ¡A¦A²MªÅ

¤j¤Zªí®æµ²ºc·|¦³¡eªí­º¡f¡e¼ÐÃD¦C¡f¡e¸ê®Æ©ú²Ó¡f¡A¬Ò¥H¡e¼ÐÃD¦C¡f¬°°Ï¹j½u

³o¬q¬O«ü­n¸ü¤J¬d¸ß¸ê®Æªº¤u§@ªí¡A¥ç§Y°õ¦ævbaªº¡e·í«e­¶¡f