¡mµo°Ý¡nvba-¦W³æ¤ñ¹ï¬Û²Å¦X¦^¼g¸ê®Æ

eric093

½Ð±Ð¦U¦ì°ª¤â¡AÃö©ó¤ñ¹ï¦W³æªºvba¼gªk¡A¥u­n²Å¦X¡m¸ê®Æ¨Ó·½¡nªºAÄæ¦ì²Å¦X¡m¦W³æ¡nºP­¶ªº¤H¦W¡A§Y±N¯S©wªºÄæ¦ì¦^¼g¦b¥t¤@­Ó¤u§@­¶¡]¤ñ¹ï«á¸ê®Æ¡^¡A
¥Ñ©ó¸ê®Æ¨Ó·½¨C¤é·|¦³¼Æ¤dµ§¡A©Ò¥H¡A§Ú¼g¤F²³æªºµ{¦¡½X«á¡A³q±`³£­nRUN«Ü¤[~¤£ª¾¹D¦³¤°»ò¤èªk¥i¥H¦A§Ö¨Ç¡I

Sub ¤ñ¹ï¦W³æ()

Sheets("¤ñ¹ï«á¸ê®Æ").Select
Cells.Clear


Sheets("¸ê®Æ¨Ó·½").Select
k = Sheets("¸ê®Æ¨Ó·½").Range("a65536").End(xlUp).Row
p = Sheets("¦W³æ").Range("a65536").End(xlUp).Row

Sheets("¤ñ¹ï«á¸ê®Æ").Cells(1, 1).Value = Sheets("¸ê®Æ¨Ó·½").Cells(1, 1)
Sheets("¤ñ¹ï«á¸ê®Æ").Cells(1, 4).Value = Sheets("¸ê®Æ¨Ó·½").Cells(1, 3)
Sheets("¤ñ¹ï«á¸ê®Æ").Cells(1, 5).Value = Sheets("¸ê®Æ¨Ó·½").Cells(1, 4)
  c = 2
For n = 2 To k
       For m = 1 To p

  If Sheets("¸ê®Æ¨Ó·½").Cells(n, 1) = Sheets("¦W³æ").Cells(m, 1) Then                     
        Sheets("¤ñ¹ï«á¸ê®Æ").Cells(c, 1).Value = Sheets("¸ê®Æ¨Ó·½").Cells(n, 1)
         Sheets("¤ñ¹ï«á¸ê®Æ").Cells(c, 3).Value = Sheets("¸ê®Æ¨Ó·½").Cells(n, 3)
        Sheets("¤ñ¹ï«á¸ê®Æ").Cells(c, 4).Value = Sheets("¸ê®Æ¨Ó·½").Cells(n, 4)
         
               c = c + 1
              
               
   
   End If
    Next
  Next
  
  

End Sub

Hsieh

¦^´_ 1# eric093

1. Sub ex()
   
2. Dim A As Range, Rng As Range, Ar(), s&
   
3. With Sheets("¦W³æ")
   
4.    For Each A In .Range(.[A2], .[A2].End(xlDown))
   
5.    With Sheets("¸ê®Æ¨Ó·½")
   
6.    Set Rng = .[A:A].Find(A, lookat:=xlWhole)
   
7.    If Not Rng Is Nothing Then
   
8.    ReDim Preserve Ar(s)
   
9.    Ar(s) = Application.Transpose(Application.Transpose(Rng.Resize(, 4).Value))
   
10.    s = s + 1
    
11.    End If
    
12.    End With
    
13.    Next
    
14. End With
    
15. With Sheets("¤ñ¹ï«á¸ê®Æ")
    
16. .[A1].CurrentRegion.Offset(1) = ""
    
17. .[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
    
18. End With
    
19. End Sub

½Æ»s¥N½X

eric093

¦^´_ 2# Hsieh


    ·PÁ¡I§Ú®M¤J«á¡A¸ê®Æ¨Ó·½²Å¦X¦W³æªº¥u·|¥X²{¤@¦¸¡A¦pªG¡A¸ê®Æ¨Ó·½¤¤¡A¤H¦W¥X²{¦h¦¸¤]·|¦P¼Ë·|±a¤J¤ñ¹ï¸ê®ÆªººP­¶¡A­n«ç»ò°µ¡H
    ¤£¦n·N«ä¡A§Ú­è­è¨S¦³ªí¹F²M·¡¡I

Hsieh

¦^´_ 3# eric093

1. Sub ex()
   
2. Dim A As Range, Rng As Range, Ar(), s&
   
3. With Sheets("¦W³æ")
   
4.    For Each A In .Range(.[A2], .[A2].End(xlDown))
   
5.    With Sheets("¸ê®Æ¨Ó·½")
   
6.    Set Rng = .[A:A].Find(A, lookat:=xlWhole)
   
7.    If Not Rng Is Nothing Then
   
8.    For Each c In .Range(Rng, Rng.End(xlDown))
   
9.    If c = A Then
   
10.       ReDim Preserve Ar(s)
    
11.       Ar(s) = Application.Transpose(Application.Transpose(c.Resize(, 4).Value))
    
12.       s = s + 1
    
13.    End If
    
14.    Next
    
15.    End If
    
16.    End With
    
17.    Next
    
18. End With
    
19. With Sheets("¤ñ¹ï«á¸ê®Æ")
    
20. .[A1].CurrentRegion.Offset(1) = ""
    
21. .[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
    
22. End With
    
23. End Sub

½Æ»s¥N½X

eric093

ÁÂÁ¡I¥i¥H®M¤J¤F¡I¦ý¬O
¥i½Ð±Ð´X­Ó°ÝÃD¶Ü¡H¡]§Úªì¤Jªù¤£¤Ó¤F¸Ñ¡A©Ò¥H°Ý¤F²Â°ÝÃD¡^

For Each A In .Range(.[A2], .[A2].End(xlDown))
¬°¤°»ò  .Range«e­±·|¦³­ÓÂI¡A¦Ó(.[A2], .[A2].¤]³£·|¦³­ÓÂI


If Not Rng Is Nothing Then  ³o¥yµ{§Ç½Xªº·N«ä¡H

s&  ³o¬O©w¸q¤°»ò¡H

¦pªG¡A§Ú·Q¨úªº¸ê®Æ¨Ó·½­Y¤£¬O³sÄòÄæ¦ì¡H¡]¥i¯à¬OA¡BB¡BC¡BG¡BIÄæ¡^¬O¤£¬O´N¤£¥i¥H¥Î
Ar(s) = Application.Transpose(Application.Transpose(c.Resize(, 4).Value))

GBKEE

¦^´_ 5# eric093
¦³¤£¸Ñ¤§³B ½×¾Â¤¤·j´MÃöÁä¦r,¦h¬Ý¬Ý·|¶i¨Bªº.
¥t¤@¼gªk¨Ñ°Ñ¦Ò

1. Option Explicit
   
2. Sub ¤ñ¹ï¦W³æ()
   
3.     Dim Rng(1 To 3) As Range, E As Range
   
4.     Sheets("¤ñ¹ï«á¸ê®Æ").UsedRange.Offset(1).Clear ''²Ä¤@¦Cªº ©m¦W,©~¦í¦a,©Ê§O,¦~ÄÖ,¤£²M°£
   
5.     Set Rng(1) = Sheets("¸ê®Æ¨Ó·½").Range("A:A")                    '¸ê®Æ¨Ó·½¦W³æ
   
6.     Set Rng(2) = Sheets("¦W³æ").Range("A2")                         '²Ä¤@­Ó¤H¦W
   
7.     Do While Rng(2) <> ""
   
8.         Set Rng(3) = Rng(1).Find(Rng(2), lookat:=xlWhole)           '¸ê®Æ¨Ó·½¦W³æ¤¤·j´M¤H¦W
   
9.         If Not Rng(3) Is Nothing Then                               'Not Rng Is Nothing :¦³§ä¨ì¤H¦W
   
10.             Rng(1).Replace Rng(2), "=gbkee", xlWhole                '±N¬Û¦Pªº¤H¦W´À´«¬°¿ù»~­È
    
11.             With Rng(1).SpecialCells(xlCellTypeFormulas, xlErrors)  '¯S®íªº½d³ò(¤½¦¡,¿ù»~­È)
    
12.                 .Value = Rng(2)                                     '¿ù»~­È§ï¦^¤H¦W
    
13.                 For Each E In .Cells                                'Each E : ¤@­Ó°}¦C©Î¶°¦X¤¤ªº¨C¤@¤¸¯À©Î¦¨­û
    
14.                     With Sheets("¤ñ¹ï«á¸ê®Æ")
    
15.                         'E.Resize(, 4).Copy .Cells(.UsedRange.Rows.Count + 1, "A")  '³sÄòªº4Äæ
    
16.                         '¥i¯à¬OA¡BB¡BC¡BG¡BIÄæ (¤£³sÄò5Äæ)
    
17.                         .Cells(.UsedRange.Rows.Count + 1, "A").Resize(, 5) = Array(E, E.Range("B1"), E.Range("C1"), E.Range("G1"), E.Range("I1"))
    
18.                     End With
    
19.                 Next
    
20.             End With
    
21.         End If
    
22.         Set Rng(2) = Rng(2).Offset(1)                               '¤U¤@­Ó¤H¦W
    
23.     Loop
    
24. End Sub

½Æ»s¥N½X

b9208

¦^´_ 6# GBKEE
Dear GBKEE
¦pªG¡ª¸ê®Æ¨Ó·½¡ªAÄ欰 12½X½s¸¹¡]¦p¡G1001QWER7895¡^
¡ª¦W³æ¡ª²Å¦X¨ä¤¤¤T½X¡]¦p¡GQWE¡^¡A½s¸¹²Ä5~7¤T½X©Î¥ô¦ó¦ì¸m¤T½X¡C
µ{¦¡½X¦p¦ó­×­q
·PÁ«ü¾É

GBKEE

¦^´_ 7# b9208

1. Option Explicit
   
2. Option Base 1
   
3. Sub ¤ñ¹ï¦W³æ()
   
4.     Dim Ar(1 To 2), Ax(), E As Variant, i As Integer, S As Integer
   
5.     Ar(1) = Application.Transpose(Sheets("¦W³æ").UsedRange.Columns(1))  '¦W³æªº¸ê®ÆÂà¤J°}¦C
   
6.     Ar(2) = Sheets("¸ê®Æ¨Ó·½").UsedRange                                '¸ê®Æ¨Ó·½ªº¸ê®ÆÂà¤J°}¦C
   
7.     S = 1
   
8.     For Each E In Ar(1)       '*** ½Ð­×¥¿ ¦W³æªº¼ÐÀY= ¸ê®Æ¨Ó·½:¦W³æªº¼ÐÀY
   
9.         For i = 1 To UBound(Ar(2))
   
10.             If InStr(Ar(2)(i, 1), E) Then    '¦³¤ñ¹ï¨ì>0 ±ø¥ó¦¨¥ß
    
11.             'InStr ¨ç¼Æ ¶Ç¦^¦b¬Y¦r¦ê¤¤¤@¦r¦êªº³Ì¥ý¥X²{¦ì¸m¡A¦¹¦ì¸m¬° Variant (Long)¡C
    
12.             ReDim Preserve Ax(S)
    
13.             Ax(S) = Application.Index(Ar(2), i)  '¨ú³sÄòÄæ¦ì
    
14.             '******* ¨ú¤£³sÄòªºÄæ¦ì 'A.B.C.E.G,H->1,2,3,5,7,8
    
15.             'Ax(S) = Array(Ax(S)(1), Ax(S)(2), Ax(S)(3), Ax(S)(5), Ax(S)(7), Ax(S)(8))
    
16.             S = S + 1
    
17.             End If
    
18.         Next
    
19.     Next
    
20.     Sheets("¤ñ¹ï«á¸ê®Æ").UsedRange.Clear    '¥þ³¡²M°£
    
21.     Sheets("¤ñ¹ï«á¸ê®Æ").[a1].Resize(UBound(Ax, 1), UBound(Ax(1))) = Application.Transpose(Application.Transpose(Ax))
    
22. End Sub

½Æ»s¥N½X

b9208

¦^´_ 8# GBKEE
«D±`·PÁª©¤j
µ{¦¡½X¥i¥H¹B¥Î°õ¦æ

eric093

ÁÂÁª©¥D´£¿ô¤Î«ü¾É¡A¤]ÁÂÁ GBKEE¡I§Ú·|¦A¥[ªoªº¡A¨C¤Ñ»{¯uª¦¤åªº¡I
¯uªº«Ü·PÁ¡I