標題: [發問] 資料庫抓取問題請教 [打印本頁]

---

作者: rouber590324    時間: 2015-12-8 15:31     標題: 資料庫抓取問題請教

DEAR ALL 大大
1. SHEET1 之 A欄   A1=羅   A2=張  A3=王
      SHEET2 之 A1=羅  B1=1
                  A2=羅  B2=2
                  A3=王  B3=3
                  A4=羅  B2=4
2.如何於  SHEET1 之 A欄為KEY 找出 SHEET2 之 ALL 符合之內容抓至 SHEET1之 B1  C1  D1 ....
  2.1  此理  SHEET1  之 B1=1   C1=2  D1=4
                              B2=空白
                                                  B3=3
3.公司無法傳檔.煩不吝賜教.

---

作者: yen956    時間: 2015-12-9 12:46

試試看:

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欄中尋找
    
13.         If Not Cel Is Nothing Then
    
14.             Fst = Cel.Address   '保存第一個位址
    
15.             Do
    
16.                 Cnt = Cnt + 1
    
17.                 Rng1.Offset(, Cnt) = Cel.Offset(, 1)
    
18.                 Set Cel = Sh2.[A:A].FindNext(Cel)     '尋找下一個
    
19.             Loop Until Fst = Cel.Address         '回到第一個位址
    
20.         End If
    
21.     Next
    
22. End Sub

複製代碼

[attach]22765[/attach]

---

作者: rouber590324    時間: 2015-12-9 14:48

DEAR  yen956 大大
TEST  OK THANKS*10000

---

作者: c_c_lai    時間: 2015-12-9 17:36

本帖最後由 c_c_lai 於 2015-12-9 17:41 編輯

回復 1# rouber590324
回復 2# yen956

將 Set Cel = Sh2.[A:A].Find(Rng1, After:=Sh2.[A65536], Lookat:=xlWhole) 的
Sh2.[A:A]  修改為 Sh2.[A:F]，就不需要再將 E7:F11 區塊內容搬移至 A5:B9。
即 Set Cel = Sh2.[A:F].Find(Rng1, After:=Sh2.[A65536], Lookat:=xlWhole)
一次會抓取 A1:F11 範圍的區塊內容來處理。
[attach]22775[/attach]

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)