請問sheet轉換的問題

tonycho33

請問sheet1是原檔(資料庫)
如何轉換成sheet2
類似vlookup的做法
依B欄的數字（順序打亂）依序填入C~J欄的資料
A、B欄可以往後再繼續延伸

謝謝

GBKEE

回復 1# tonycho33
sheet1是原檔(資料庫) 轉換成sheet2   看不出差別在哪裡,如何轉換也看不懂

register313

回復 2# GBKEE

是要查表啦!
注意SHEET1與SHEE2之B欄是不同的
在SHEE2 B欄輸入欲查詢之資料,即查出相對應C~J欄的資料(有3列)

本題是要用程式寫
另一題(如下)是用公式寫
sheet-vlookup.zip (4.45 KB)

下載次數: 9

2012-1-17 21:54

register313

回復 1# tonycho33

1. Sub VLOOKUP()
   
2. '清除Sheet2之C~J欄
   
3. Sheet2.Columns("C:J") = ""
   
4.    '從Sheet2之第R列(第2列)開始
   
5.    R = 2   
   
6.    '執行迴圈,直到Sheet2 R列B欄之值=""
   
7.    Do Until Sheet2.Cells(R, "B") = ""
   
8.       'FIND函數:在Sheet1.Range("B1:B65535")內尋找Sheet2.Cells(R, "B")之值,找到時將位址傳給S
   
9.       Set S = Sheet1.Range("B1:B65535").Find(Sheet2.Cells(R, "B"), , , xlWhole)
   
10.       '在Sheet1找到之位址右偏移1格並擴大為3列8欄 複製到 Sheet2
    
11.       S.Offset(0, 1).Resize(3, 8).Copy Sheet2.Cells(R, "C").Resize(3, 8)
    
12.       '下一個要尋找的列(第5列)(第8列)...
    
13.       R = R + 3
    
14.    '返回迴圈
    
15.    Loop
    
16. End Sub

複製代碼

GBKEE

回復 4# register313
也可如此

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     'Target:程式所接收的變數, As Range:  儲存格(物件)
   
4.     Dim xMatch As Variant, Rng As Range
   
5.     Application.EnableEvents = False
   
6.     If Target.Column = 2 And Target.MergeCells Then  '在B欄 且是 MergeCells(範圍或樣式包含合併儲存格)
   
7.         Set Rng = Target.Offset(, 1).Resize(3, 8)
   
8.         With Sheets("SHEET1")
   
9.             xMatch = Application.Match(Target, .[B:B], 0)  'Match(工作表函數)
   
10.             If IsNumeric(xMatch) Then                      '找到傳回數字
    
11.                 Rng = .Cells(xMatch, "B").Offset(, 1).Resize(3, 8).Value
    
12.             Else
    
13.                 Rng.Value = ""
    
14.             End If
    
15.         End With
    
16.     End If
    
17.     Set Rng = Nothing                               '釋放變數
    
18.     Application.EnableEvents = True
    
19. End Sub

複製代碼

tonycho33

回復 5# GBKEE


    可以解釋一下嗎
謝謝

tonycho33

回復 4# register313


    請問我現在格式做了一點變動

1. Sub VLOOKUP()
   
2. Sheet2.Columns("G:S") = ""
   
3. R = 2                                 
   
4.    Do Until Sheet2.Cells(R, "A") = ""  
   
5.       Set S = Sheet1.Range("A1:A65535").Find(Sheet2.Cells(R, "A"), , , xlWhole)                                   
   
6.       S.Offset(0, 5).Resize(3, 13).Copy Sheet2.Cells(B, "G").Resize(3, 13)                                    
   
7.       R = R + 3                                       
   
8.    Loop
   
9. End Sub

複製代碼

請協助看為何無法執行
另外,使用函數要如何修改
原函數
C2=OFFSET(INDEX(Sheet1!$A$1:$J$20,MATCH($B2,Sheet1!$B$1:$B$20,0),COLUMN()),MOD(ROW()+1,3),0)
謝謝

register313

回復 7# tonycho33

程式
sheet-vlookup程式.rar (9.3 KB)

下載次數: 8

2012-1-18 14:28

函數
G2=OFFSET(INDEX(Sheet1!$A:$R,MATCH($A2,Sheet1!$A:$A,0),COLUMN()-1),MOD(ROW()+1,3),0)
G3=OFFSET(INDEX(Sheet1!$A:$R,MATCH($A2,Sheet1!$A:$A,0),COLUMN()-1),MOD(ROW()+1,3),0)
G4=OFFSET(INDEX(Sheet1!$A:$R,MATCH($A2,Sheet1!$A:$A,0),COLUMN()-1),MOD(ROW()+1,3),0)
G2 G3 G4公式相同

選G2:G4 向右拉
向下拉

tonycho33

回復 8# register313


    你好
請問一下
在sheet2的A欄儲存格內，如果輸入的值不是sheet1 的A欄值時
例如
A23～A25＝3332
A26～A28＝3334
這樣的時候
程式執行會出現錯誤，可否輸入值不一樣時，G～S欄只出現空白
要如何解決修改呢
謝謝

register313

回復 9# tonycho33

1. Sub VLOOKUP()
   
2. Sheet2.Columns("G:S") = ""   '清除Sheet2之G~S欄
   
3. R = 2   '從Sheet2之第R列(第2列)開始
   
4.    Do Until Sheet2.Cells(R, "A") = ""  '執行迴圈,直到Sheet2 R列A欄之值=""
   
5.       Set s = Sheet1.Range("A1:A65535").Find(Sheet2.Cells(R, "A"), , , xlWhole)  'FIND函數:在Sheet1.Range("A1:A65535")內尋找Sheet2.Cells(R, "A")之值,找到時將位址傳給S
   
6.           If Not s Is Nothing Then     '搜尋值找到時再作寫入
   
7.              s.Offset(0, 5).Resize(3, 13).Copy Sheet2.Cells(R, "G").Resize(3, 13)    '在Sheet1找到之位址右偏移5格並擴大為3列13欄 複製到 Sheet2
   
8.           End If
   
9.       R = R + 3     '下一個要尋找的列(第5列)(第8列)...
   
10.    Loop  '返回迴圈
    
11. End Sub

複製代碼

sheet-vlookup程式.rar (9.29 KB)

下載次數: 8

2012-1-19 11:08