[µo°Ý] ¸ê®Æ®w§ì¨ú°ÝÃD½Ð±Ð

rouber590324

DEAR ALL ¤j¤j
1. SHEET1 ¤§ AÄæ   A1=ù   A2=±i  A3=¤ý
      SHEET2 ¤§ A1=ù  B1=1
                  A2=ù  B2=2
                  A3=¤ý  B3=3
                  A4=ù  B2=4
2.¦p¦ó©ó  SHEET1 ¤§ AÄ欰KEY §ä¥X SHEET2 ¤§ ALL ²Å¦X¤§¤º®e§ì¦Ü SHEET1¤§ B1  C1  D1 ....
  2.1  ¦¹²z  SHEET1  ¤§ B1=1   C1=2  D1=4
                              B2=ªÅ¥Õ
                                                  B3=3
3.¤½¥qµLªk¶ÇÀÉ.·Ð¤£§[½ç±Ð.

yen956

¸Õ¸Õ¬Ý:

1. Private Sub CommandButton1_Click()
   
2.     Dim Sh1 As Worksheet, Sh2 As Worksheet
   
3.     Dim Rng1 As Range, Cel As Range, Fst As String
   
4.     Dim I As Integer, Cnt As Integer, R1 As Integer
   
5.     Set Sh1 = Sheets("Sheet1")
   
6.     Set Sh2 = Sheets("Sheet2")
   
7.     Sh1.[B1:P10] = ""
   
8.     R1 = Sh1.[A65536].End(xlUp).Row
   
9.     For I = 1 To R1
   
10.         Set Rng1 = Sh1.Cells(I, 1)
    
11.         Cnt = 0
    
12.         Set Cel = Sh2.[A:A].Find(Rng1, After:=Sh2.[A65536], Lookat:=xlWhole)      'AÄ椤´M§ä
    
13.         If Not Cel Is Nothing Then
    
14.             Fst = Cel.Address   '«O¦s²Ä¤@­Ó¦ì§}
    
15.             Do
    
16.                 Cnt = Cnt + 1
    
17.                 Rng1.Offset(, Cnt) = Cel.Offset(, 1)
    
18.                 Set Cel = Sh2.[A:A].FindNext(Cel)     '´M§ä¤U¤@­Ó
    
19.             Loop Until Fst = Cel.Address         '¦^¨ì²Ä¤@­Ó¦ì§}
    
20.         End If
    
21.     Next
    
22. End Sub

½Æ»s¥N½X

¤U¸ü (74.49 KB)

2015-12-9 12:46

rouber590324

DEAR  yen956 ¤j¤j
TEST  OK THANKS*10000

c_c_lai

¦^´_ 1# rouber590324
¦^´_ 2# yen956

±N Set Cel = Sh2.[A:A].Find(Rng1, After:=Sh2.[A65536], Lookat:=xlWhole) ªº
Sh2.[A:A]  ­×§ï¬° Sh2.[A:F]¡A´N¤£»Ý­n¦A±N E7:F11 °Ï¶ô¤º®e·h²¾¦Ü A5:B9¡C
§Y Set Cel = Sh2.[A:F].Find(Rng1, After:=Sh2.[A65536], Lookat:=xlWhole)
¤@¦¸·|§ì¨ú A1:F11 ½d³òªº°Ï¶ô¤º®e¨Ó³B²z¡C

¤U¸ü (22.34 KB)

2015-12-9 17:35