Board logo

標題: 請問sheet轉換的問題 [打印本頁]
作者: tonycho33    時間: 2012-1-17 13:37     標題: 請問sheet轉換的問題

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

謝謝
作者: GBKEE    時間: 2012-1-17 20:44

回復 1# tonycho33
sheet1是原檔(資料庫) 轉換成sheet2   看不出差別在哪裡,如何轉換也看不懂
作者: register313    時間: 2012-1-17 21:58

回復 2# GBKEE

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

本題是要用程式寫
另一題(如下)是用公式寫
[attach]9245[/attach]
作者: register313    時間: 2012-1-18 00:40

本帖最後由 register313 於 2012-1-18 14:16 編輯

回復 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    時間: 2012-1-18 09:31

本帖最後由 GBKEE 於 2012-1-18 10:17 編輯

回復 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    時間: 2012-1-18 09:48

回復 5# GBKEE


    可以解釋一下嗎
謝謝
作者: tonycho33    時間: 2012-1-18 13:58

本帖最後由 tonycho33 於 2012-1-18 14:12 編輯

回復 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    時間: 2012-1-18 14:30

回復 7# tonycho33

程式
[attach]9251[/attach]

函數
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    時間: 2012-1-19 10:53

回復 8# register313


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

回復 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
複製代碼
[attach]9268[/attach]



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