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

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

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

¥»©«³Ì«á¥Ñ sss1159 ©ó 2015-11-6 11:31 ½s¿è

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ÁÂÁÂ

search.zip (10.61 KB)

©êº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ÁÂ

search.zip (24.08 KB)

TOP

°Ú°Ú°Ú><
¤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?

TOP

­ã´£³¡ª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ÁÂ:$

TOP

¦^´_ 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¾Ç²ß¤¤:$

TOP

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

­è¹ê»Ú¾Þ§@¤@¹M¡A¹ê¦b¤Ó¼F®`¤F!!!!
§Ú«á¨Ó¦b¤u§@ªí1 ·s¼W¤F¤@­Ó±Æ§Çªº¥\¯à(¿ý»s¥¨¶°)
ÁÙ¨S¶ë¿ï®É ¬O¯à¥¿±`±Æ§Çªº
¦ý§Ú¤@¦ý¶ë¿ï®É ¦A±Æ§Ç EXCEL´N·í±¼¤F

¦A³Â·Ð±z¤F ·PÁ·PÁÂ
ªþ¤W»yªk

Sub ¥¨¶°3()
'
' ¥¨¶°3 ¥¨¶°
'

'
    Range("E4:E10000").Select
    ActiveWorkbook.Worksheets("¤u§@ªí1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("¤u§@ªí1").Sort.SortFields.Add Key:=Range("E4:E10000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("¤u§@ªí1").Sort
        .SetRange Range("A3:E10000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("E4").Select
    Selection.End(xlDown).Select
End Sub

³]1¸U ¬O©È¤é«á¸ê®Æ¶V¨Ó¶V¦h XD"

TOP

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

ª`·N¡G¿z¿ïª¬ºA®É¡A­Y¤£¥ý¸Ñ°£¿z¿ï¡A¥ô¦ó¾Þ§@³£¥i¯à³y¦¨µLªkÀ±¸Éªº¿ù»~¡]¤×¨ä¬O¤w°õ¦æ¤FÀx¦sµ²ªG¡^

¦A´ú¸Õ®É¡A´N·í¤F¦n´X¦¸XD"

¥[¤F¨º¬q«á¡A´N¤£·|·í¤F¡A¦ý¬O¶ë¿ï·|³Q¨ú®ø±¼¡A½Ð°Ý¦³¿ìªk¶ë¿ï§¹¡A¦A±Æ§Ç¶ë¿ïªº¸ê®Æ¶Ü?

¤£¦n·N«ä¡A¤@ª½³Â·Ð±z:dizzy:
ªþ¤WÀÉ®×µ¹±z¬Ý

search.zip (28.2 KB)

TOP

¦^´_ 15# GBKEE

±z¦n¡A¨Ï¥Î¤F±zªº¤èªkÁÙ¬O·|¶]¥X­ì¥»ªº¸ê®Æ
§Úªþ­Ó¥Ü·N¹Ï=)

¦b³Â·Ð¤F><

¹Ï¤ù 6.png (46.08 KB)

¹Ï¤ù 6.png

TOP

ÁÂÁ ¨â¦ìª©¥D©âªÅ¦^ÂÐ
¾Ç¨ì¤F«Ü¦h¡AºÃ°Ý¤]³£¸Ñ¨M¤F¡A
§Ú¦A¸ÕµÛ½m²ß¬Ý¬Ý¡A«D±`·PÁÂ

TOP

¦^´_ 17# GBKEE

°¨¤W´N¦³°ÝÃD¤F....ʨ
¥Ñ©ó¤W¤èµù¸Ñ»Ý­n¦h¤@¦æ¡AÅܦ¨¼ÐÃDÄæ¦bA4~E6
±N GBKEE¤jªº»yªkµy°µ­×¥¿

Sub ¿z¿ï123()
    Dim X$
    X = Application.InputBox("½Ð¿é¤J¿z¿ïÃöÁä¦r")
    If X = "" Or X = "False" Then Exit Sub
    With Sheets("¤u§@ªí3").[A4]  '
        .Parent.AutoFilterMode = False
        '¿z¿ï«e¤]¥i©Ò¦³¸ê®Æ [·s¼W¤é´Á]±Æ§Ç
        '.CurrentRegion.Sort Key1:=.Range("E2"), Order1:=xlAscending, Header:=xlYes
        .AutoFilter Field:=1, Criteria1:="*" & X & "*"
        If .End(xlDown).Row = Rows.Count Then MsgBox "§ä¤£¨ì¸ê®Æ!!": Exit Sub
        '¥u¹ï¿z¿ï«á¸ê®Æ[·s¼W¤é´Á]±Æ§Ç
        .CurrentRegion.Sort Key1:=.Range("C4"), Order1:=xlAscending, Header:=xlYes
    End With
End Sub

¶ë¿ï«á½T¥X²{¼ÐÃD¤]¤@¨Ö±Æ§Ç¶]¨ì³Ì¤U­±¥h¤F¡A¾É­Pª©­±¶Ã¤F...
¦A³Â·Ð¤F¦h¦¸¥oÂZ...

¹Ï¤ù 14.png (5.07 KB)

¹Ï¤ù 14.png

TOP

        ÀR«ä¦Û¦b : ¨C¤ÑµL©Ò¨Æ¨Æ¡A¬O¤H¥Íªº®ø¶OªÌ¡A¿n·¥¡B¦³¥Î¤~¬O¤H¥Íªº³Ð³yªÌ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD