Board logo

標題: 不好意思 新手又來請教 資料比對問題 麻煩各位了 [打印本頁]
作者: ffntldj    時間: 2011-7-19 22:37     標題: vba 比對資料問題

不好意思 小弟這問題已經困擾很久 實在想不出來 所以上來求救 ,謝謝大家撥時間幫我看

有兩個excel檔,如附件

book1裡面的c sheet 是我想要建立一個button的地方,按下去之後能夠做以下動作

目的是希望能夠把book2 (b sheet) 裡面的資料 抓到book1的 (a sheet ),

也就是把顏色標出來的地方book2.b.sheet,COPY到book1.a.sheet

附檔的顏色是我後來加上去的,只是為了方便描述 ,

part_id 填完了往右邊儲存格shift一位 依此類推,

ope_no只需抓後三碼 前後需要固定用(),用,號隔開,每個數字都要有 ' '

內容已經簡化,實際上的table資料蠻多,不單只是兩筆, 我認為要用for迴圈 但還很嫩 不太熟 請教各位了

以上  感激不盡
[attach]7060[/attach]
作者: ffntldj    時間: 2011-7-20 11:06

請問板大 不好意思 再請教一個問題 這樣的需求我可以參考書籍中的哪些function ? 謝謝
作者: GBKEE    時間: 2011-7-20 11:44

回復 2# ffntldj
特殊的需求 要自訂函數 你1 樓的需求 說的不清楚  book2  b欄 是遇到ope_no的下一列取3碼後的嗎?
a,d,e.f 如何來的
a        111
part_id        12345
ope_no        ('333','444','555','777')
d        444
e        555
f        666
f        777
作者: ffntldj    時間: 2011-7-20 13:37

板大你好~adef 只是我假設有其他的欄位已經在book1裡面,在book1中主要是去看ope_no 跟part_id 這兩個儲存格右手邊的資料(parit-id---->12345, ope_no ---> 333 444 555 777),這些資料是從book2裡面的b sheet來的,只是在book2 copy過來之後 在book1要做一些修改 ,ope_no 就是要變為 ('333','444','555','777')加上括弧,逗號和分號
partid 則是如果在book2裡面有一個以上的part_id出現時 ,在填入book1的時後,要變成  part id  12345   5678 (5678要填在12345旁邊那個儲存格)      

不知道這樣有清楚嗎? 謝謝你 我也會自己在試著寫~
作者: GBKEE    時間: 2011-7-20 14:20

回復 4# ffntldj
還是不清楚 ,範例請不要隨便列舉
作者: Hsieh    時間: 2011-7-20 14:34

回復 4# ffntldj


    就單純把book2的b工作表中part_id對應modify後3碼填入a工作表的第2、3列
  1. Sub nn()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With Workbooks.Open("D:\book2.xls") '檔案路徑自行修改
  4. With .Sheets("b")
  5. For Each a In .Range(.[A1], .[A65536].End(xlUp))
  6.   If a = "part_id" Then mystr = a.Offset(, 1).Text
  7.   If a = "modify" Then
  8.      If d(mystr) = "" Then
  9.         d(mystr) = "'" & Right(a.Offset(, 1), 3) & "'"
  10.         Else
  11.         d(mystr) = d(mystr) & ",'" & Right(a.Offset(, 1), 3) & "'"
  12.      End If
  13.   End If
  14. Next
  15. End With
  16. .Close
  17. End With
  18. With Sheets("a")
  19. k = 2
  20. For Each ky In d.keys
  21.    .Cells(2, k) = ky
  22.    .Cells(3, k) = "(" & d(ky) & ")"
  23. k = k + 1
  24. Next
  25. End With
  26. End Sub
複製代碼
作者: ffntldj    時間: 2011-7-20 15:21

@超級版主   謝謝你 我在研究一下你的寫法  
@版主    抱歉 我在描述清楚一點 謝謝
作者: ffntldj    時間: 2011-7-20 19:09

謝謝兩位版主, code我已經看完了也看懂了,也自己試著做了一些修改 非常感謝
有兩個問題想請教
第一個問題就是 以下這段code為什麼沒有對應的end if? 是不需要嗎?
If a = "part_id" Then mystr = a.Offset(, 1).Text
第二個問題是
這個code主要是把part_id 可以跟 ope_no去做對應 ,如下表示
part_id                   y                   z
                   ('356','456')        ('556')
如果我想改成
part_id                   y                              z
                   ('356','456','556')      
應該是修改以下這一段code,試了一下午,可否再教我一下 感激不盡
If d(mystr) = "" Then
     d(mystr) = "'" & Right(a.Offset(, 1), 3) & "'"
      Else
      d(mystr) = d(mystr) & ",'" & Right(a.Offset(, 1), 3) & "'"
     End If
作者: Hsieh    時間: 2011-7-20 20:55

本帖最後由 Hsieh 於 2011-7-20 20:58 編輯

回復 8# ffntldj
問題1
IF陳述式的語法兩種
1.   
If 判斷式 then 執行陳述式
2.   
If 判斷式 then
          執行TRUE陳述式
       Else
          執行False陳述式
End If
問題2
這樣你就不分part_id
只是把所有modify的號碼全寫入同一個儲存格嗎?
  1. Sub nn()
  2. With Workbooks.Open("D:\book2.xls") '檔案路徑自行修改
  3. With .Sheets("b")
  4. For Each a In .Range(.[A1], .[A65536].End(xlUp))
  5.   If a = "modify" Then
  6.      If mystr = "" Then
  7.         mystr = "'" & Right(a.Offset(, 1), 3) & "'"
  8.         Else
  9.         mystr = mystr & ",'" & Right(a.Offset(, 1), 3) & "'"
  10.      End If
  11.   End If
  12. Next
  13. End With
  14. .Close
  15. End With
  16. With Sheets("a")
  17.    .Cells(3, 2) = "(" & mystr & ")"
  18. End With
  19. End Sub
複製代碼
作者: ffntldj    時間: 2011-7-20 22:57

謝謝版主你熱心的回覆 真的很感謝

有問題想請教 上面這各code的mystr 不用定義嘛?? 不用用到Dictionary了?這樣寫是定義mystr是矩陣的意思嘛?

我應該是不分part id 把ope_no寫進去儲存格裡沒錯
但是part_id 是要分儲存格的 如下面 y z 這樣
part_id                   y                      z            
                       ('356','456','556')      

我會好好努力的 謝謝
作者: ffntldj    時間: 2011-7-21 09:48

to 超級版主 下面的那個功能我寫出來了!! 感謝 那個mystr不用定義那個問題在麻煩你教我一下 謝謝
作者: Hsieh    時間: 2011-7-21 12:22

回復 10# ffntldj

抱歉!這是我的習慣不好
    mystr未宣告，你可自己加進去
把mystr為字串
未宣告的變數，EXCEL會認為是Variant
會自己判斷應該屬於哪一種變數存在
你可由程式碼逐行中看出mystr的變化
就知道他是甚麼型態的變數了
作者: ffntldj    時間: 2011-7-21 12:33

了解 謝謝你 目前已用這個架構去建立我想要的功能

另外跟你請問一個問題 如果我想要把輸入改成可以選擇檔案

是不是用application.getopenfilename

試了一下 在 With .Sheets("b") 會有問題

感激不盡
作者: ffntldj    時間: 2011-7-21 12:35

回復 13# ffntldj
抱歉沒說清楚  應是以下這段 改成選擇檔案
With Workbooks.Open '("D:\工程師送件範例.xls") '檔案路徑自行修改
作者: Hsieh    時間: 2011-7-21 13:11

getopenfilename會得到?
workbooks.open括號中是否與你getopenfilename得到的相同?
了解各個指令的參數資料型態，應是你目前最需要清楚的觀念
請利用F8的逐行功能來檢查變數的變化
作者: ffntldj    時間: 2011-7-22 00:29

本帖最後由 ffntldj 於 2011-7-22 23:18 編輯

回復 15# Hsieh

我寫出來了~~~ 謝謝 程式碼稍後附上

如下

myfile = workbook.application.getopenfilename ("excel文件(*.xls),*.xls")
with workbooks.open(myfile)

就可以用滑鼠點檔案了

感謝版主~
作者: ffntldj    時間: 2011-7-23 00:59     標題: 不好意思 新手又來請教 資料比對問題 麻煩各位了

本帖最後由 ffntldj 於 2011-7-23 01:26 編輯

不好意思 實在寫不出來 用了一堆if 跟for 實在好難  有問題想請教,
   資料不只三筆 只列出三筆 (附圖如下)

   1.如果想把 A sheet裡 mod part以下 action以上 (紅色字體 )裡的資料 填入A1 但是如果資料是重覆 ,則不重複表示 (如A1 sheet) 該怎麼做?

       之前是用板大教的
       Set d = CreateObject("Scripting.Dictionary")
    If a = "Mod part" Then mystr = a.Offset(1,0).Text

     但是如果遇到Mod part下面有很多筆 就不知道該怎麼寫了

   2. 比對A sheet 和 C sheet裡面的資料,當A sheet裡的紅色跟藍色 , 跟B sheet的partid欄位跟ope_no欄位

      都能夠match的話,將對應到的資料放到  B1 sheet裡面 (如B1所示)
    [attach]7113[/attach]

附件如下   再麻煩大家了 真是不好意思[attach]7114[/attach]
作者: GBKEE    時間: 2011-7-23 06:45

本帖最後由 GBKEE 於 2011-7-23 09:23 編輯

回復 1# ffntldj
比對A sheet 和 C sheet裡面的資料   附黨中沒有C sheet 可以更新嗎?
  1. Sub 解答1Ex()
  2.     Dim Rng As Range, Ar, Msg As Boolean
  3.     Dim Word_In As String, Word_Out As String
  4.     Word_In = "Mod part"            '進入字串
  5.     Word_Out = "ACTION"             '離開字串
  6.     Set Rng = Sheets("A").[A1]      '尋找字串的起始點
  7.     ReDim Ar(0)                     '重新宣告陣列的維數
  8.     Do
  9.         If Rng = Word_In Then Msg = True        '是進入字串 邏輯值=True
  10.         If Rng = Word_Out Then Msg = False      '是離開字串 邏輯值=False
  11.         If Msg = True And Rng <> Word_In Then   '邏輯值=True 且字串不是"進入字串"
  12.             ' Application.Match(Rng, Ar, 0)     '在陣列比對不到同樣的字串 傳回錯誤值
  13.             If IsError(Application.Match(Rng, Ar, 0)) Then    '傳回錯誤值
  14.                 If Ar(UBound(Ar)) <> "" Then ReDim Preserve Ar(UBound(Ar) + 1)
  15.                                                         'Preserve   保留陣列原有資料的關鍵字
  16.                 Ar(UBound(Ar)) = Rng                    'UBound(Ar)  陣列的最大維數
  17.             End If
  18.         End If
  19.         Set Rng = Rng.Offset(1)                         '設定 Rng=Rng的下一列
  20.     Loop Until Rng = ""                                 '離開 DO 迴圈的條件是 Until(直到)  Rng = ""
  21.     Sheets("A1").Rows(1) = ""                           '整列
  22.     Sheets("A1").[A1].Resize(1, UBound(Ar) + 1) = Ar    'Resize 儲存格擴充範圍(1列, 欄位:=UBound(Ar) + 1)
  23. End Sub
複製代碼
  1. Sub 解答2Ex()
  2.     Dim Rng(1 To 2) As Range, Ar, Msg As Boolean, R As Range
  3.     Dim Word_In As String, Word_Out As String, Word_Look As String
  4.     Word_In = "Mod part"            '進入字串
  5.     Word_Out = "ACTION"             '離開字串
  6.     Word_Look = "MODIFY"
  7.     Set Rng(1) = Sheets("A").[A1]   '尋找字串的起始點
  8.     ReDim Ar(0)                     '重新宣告陣列的維數
  9.     Do
  10.         If UCase(Rng(1)) = UCase(Word_In) Then Msg = True        '是進入字串 邏輯值=True
  11.         If UCase(Rng(1)) = UCase(Word_Out) Then Msg = False      '是離開字串 邏輯值=False
  12.         If Msg = True And UCase(Rng(1)) <> UCase(Word_In) Then   '邏輯值=True 且字串不是"進入字串"
  13.             Set Rng(2) = Sheets("a").Columns(1).Find(Word_Look, After:=Rng(1), lookat:=xlWhole, MatchCase:=False)  '尋找最接近的 "MODIFY"
  14.             If IsError(Application.Match(Rng(1) & Rng(2).Offset(, 1), Ar, 0)) Then    '比對不到 "PARTID&OPE_NO"字串 傳回錯誤值
  15.                 If Ar(UBound(Ar)) <> "" Then ReDim Preserve Ar(UBound(Ar) + 1)
  16.                 Ar(UBound(Ar)) = Rng(1) & Rng(2).Offset(, 1)    'UBound(Ar)  陣列的最大維數
  17.             End If
  18.         End If
  19.         Set Rng(1) = Rng(1).Offset(1)                           '設定 Rng(1)=Rng(1)的下一列
  20.     Loop Until Rng(1) = ""                                      '離開 DO 迴圈的條件是 Until(直到)  Rng(1) = ""
  21.     Set Rng(1) = Nothing                                        '釋放變數
  22.     For Each R In Sheets("B").Range("a1").CurrentRegion.Rows    'R ->依序在Sheets("B")[A1延伸範圍的每一列
  23.         If Not IsError(Application.Match(R.Cells(1) & R.Cells(2), Ar, 0)) Then  '陣列中比對到SHEETS("B") A欄&B欄 的字串
  24.             If Rng(1) Is Nothing Then Set Rng(1) = R Else Set Rng(1) = Union(Rng(1), R)                                    '設定變數
  25.         End If
  26.     Next
  27.     With Sheets("B1")
  28.        .UsedRange.Clear        '清除 Sheets("B1")的內容
  29.         Rng(1).Copy .[A1]
  30.     End With
  31. End Sub
複製代碼
作者: ffntldj    時間: 2011-7-23 12:55

比對A sheet 和 C sheet裡面的資料,當A sheet裡的紅色跟藍色 , 跟B sheet的partid欄位跟ope_no欄位
此處打錯 應該是 比對A sheet 和 B sheet ,當A sheet裡的紅色跟藍色 , 跟B sheet的partid欄位跟ope_no欄位
抱歉  程式碼我研究一下
作者: ffntldj    時間: 2011-7-25 20:31

版主你好

謝謝你的code 讓我獲益良多 很感謝你   code沒有問題 ,但有些地方我看不懂 google過了也還是不會

想直接跟你請教,謝謝

1.   If IsError(Application.Match(Rng, Ar, 0))   這句是"在陣列比對不到同樣的字串 傳回錯誤"
      是說 如果ar裡面不是Mod part和ACTION就會傳回值然後往下走嘛?

2.  If IsError(Application.Match(Rng(1) & Rng(2).Offset(, 1), Ar, 0)) Then   
     這邊的ope_no 是用Offset的方式去寫,今天再想一各問題 如果想用欄位名稱(ope_no)去認的話這邊該怎麼改寫?是不是用一個回圈去抓第一列的名字?

3.如果A sheet在比對 B sheet時候, 如果只要B sheet裡PART ID的第一碼到第N碼  (如TMD1213 ,TMD1214)當他等於 A Sheet裡面的值時 ,也要把它抓出來的話 該怎麼做? 這我真的就不會了~~

以上 謝謝
作者: GBKEE    時間: 2011-7-26 10:37

回復 20# ffntldj
1.   If IsError(Application.Match(Rng, Ar, 0))   這句是"在陣列比對不到同樣的字串 傳回錯誤"    是說 如果ar裡面不是Mod part和ACTION就會傳回值然後往下走嘛?
   A:不是的, 是 Rng 比對  Ar 陣列中(TMD12,TDD13,MDT143,MDT14.....)  到沒有重複的, 然後下面的程式碼 將Rng的值加入 Ar 陣列中

2.  If IsError(Application.Match(Rng(1) & Rng(2).Offset(, 1), Ar, 0)) Then   
     這邊的ope_no 是用Offset的方式去寫,今天再想一各問題 如果想用欄位名稱(ope_no)去認的話這邊該怎麼改寫?是不是用一個回圈去抓第一列的名字?
    A:不了解你的意思
3.如果A sheet在比對 B sheet時候, 如果只要B sheet裡PART ID的第一碼到第N碼  (如TMD1213 ,TMD1214)當他等於 A Sheet裡面的值時 ,也要把它抓出來的話 該怎麼做? 這我真的就不會了~~
修改一下,是這樣碼?
  1. Sub 解答2Ex()
  2. Dim Rng(1 To 2) As Range, Ar, Msg As Boolean, R As Range, N As String
  3. Dim Word_In As String, Word_Out As String, Word_Look As String
  4. Word_In = "Mod part" '進入字串
  5. Word_Out = "ACTION" '離開字串
  6. Word_Look = "MODIFY"
  7. Set Rng(1) = Sheets("A").[A1] '尋找字串的起始點
  8. ReDim Ar(0) '重新宣告陣列的維數
  9. Do
  10. If UCase(Rng(1)) = UCase(Word_In) Then Msg = True '是進入字串 邏輯值=True
  11. If UCase(Rng(1)) = UCase(Word_Out) Then Msg = False '是離開字串 邏輯值=False
  12. If Msg = True And UCase(Rng(1)) <> UCase(Word_In) Then '邏輯值=True 且字串不是"進入字串"
  13. Set Rng(2) = Sheets("a").Columns(1).Find(Word_Look, After:=Rng(1), lookat:=xlWhole, MatchCase:=False) '尋找最接近的 "MODIFY"
  14. If IsError(Application.Match(Rng(1) & Rng(2).Offset(, 1), Ar, 0)) Then '比對不到 "PARTID&OPE_NO"字串 傳回錯誤值
  15. If Ar(UBound(Ar)) <> "" Then ReDim Preserve Ar(UBound(Ar) + 1)
  16. Ar(UBound(Ar)) = Rng(1) & Rng(2).Offset(, 1) 'UBound(Ar) 陣列的最大維數
  17. End If
  18. End If
  19. Set Rng(1) = Rng(1).Offset(1) '設定 Rng(1)=Rng(1)的下一列
  20. Loop Until Rng(1) = "" '離開 DO 迴圈的條件是 Until(直到) Rng(1) = ""
  21. Set Rng(1) = Nothing '釋放變數
  22. For Each R In Sheets("B").Range("a1").CurrentRegion.Rows 'R ->依序在Sheets("B")[A1延伸範圍的每一列
  23. N = Mid(R.Cells(1), 1, 4) '篩選準則: PART ID的第一碼到第 4 碼
  24. 'Filter(Ar, N, True) ->傳回陣列 包含基於指定篩選準則的一個字串陣列的子集
  25. If UBound(Filter(Ar, N, True)) > -1 Then '-1 陣列中不是空的:有比對到) A欄 的字串
  26. If Rng(1) Is Nothing Then Set Rng(1) = R Else Set Rng(1) = Union(Rng(1), R) '設定變數
  27. End If
  28. Next
  29. With Sheets("B1")
  30. .UsedRange.Clear '清除 Sheets("B1")的內容
  31. Rng(1).Copy .[A1]
  32. End With
  33. End Sub
複製代碼
作者: ffntldj    時間: 2011-7-26 23:46

你好 謝謝版主跟超級版主的大力幫忙 有這個網站對我來說實在是獲益良多~ 謝謝你們

小弟初學vba 很多東西不會　都是在這努力爬文的　很感謝有這地方

以上的code沒錯 錯的是我自己的觀念 謝謝你們的糾正

14.If IsError(Application.Match(Rng(1) & Rng(2).Offset(, 1), Ar, 0)) Then
這邊抓到的rng(2)是MODIFY 然後用shift去抓ope_no的值,我的意思是 如果不用offset 有什麼方式可以去認他的欄位名稱 ope_no ?

22.For Each R In Sheets("B").Range("a1").CurrentRegion.Rows 'R ->依序在Sheets("B")[A1延伸範圍的每一列

這應該是把b-sheet 一列一列的資料往下抓出來,如果我像上面一樣也是需要抓欄位名稱呢?

(就是當b-sheet part_id 跟 ope_no 都符合時,可以去抓到flow 跟flow1的名稱,然後把它copy到b1 sheet)

不知道這樣的描述看的懂嘛 謝謝版主
作者: GBKEE    時間: 2011-7-27 09:11

回復 22# ffntldj
Q1: 如果不用offset 有什麼方式可以去認他的欄位名稱 ope_no ?
A1:請往看13行:  Set Rng(2) = Sheets("a").Columns(1).Find(Word_Look, After:=Rng(1), lookat:=xlWhole, MatchCase:=False) '尋找最接近的 "MODIFY"
ope_no  在 MODIFY的右邊一欄 當然是用   Rng(2).Offset(, 1) 來表示最簡便, 或是  Sheets("a").Range( "B" & Rng(2).Row)  也可以

Q2:這應該是把b-sheet 一列一列的資料往下抓出來,如果我像上面一樣也是需要抓欄位名稱呢?
(就是當b-sheet part_id 跟 ope_no 都符合時,可以去抓到flow 跟flow1的名稱,然後把它copy到b1 sheet)
A2: VBA要抓資料的語法不止一個 ,如上 Sheets("a").Range( "B" & Rng(2).Row) 你可慢慢體會.
作者: ffntldj    時間: 2011-8-1 22:42

回復 23# GBKEE

不好意思 研究了一個禮拜 還是很痛苦 很多問題 再來請教~ 謝謝

1 如附檔 A SHEET,之前都沒有空白格開(現在有空白 所以不能用Do ,Loop Until Rng = "",我把它改寫成For each rng(1) in sheet("a").range(sheet(a).[A1],sheet(a)[A65536].End(xlup))
但現在遇到一個問題  之前ACTION 下方只會有一個MODIFY, 現在會有很多個,如果用 Set Rng(2) = Sheets("a").Columns(1).Find(Word_Look, After:=Rng(1), lookat:=xlWhole, MatchCase:=False)  '尋找最接近的 "MODIFY"
只會抓的到第一個. 如果ACTION下方 只要是MODIFY SPEC的 我都要抓到 該怎麼做,如下範例

TMD101-E121--240.05
TMD102-E123--240.05
TMD103-E124--240.05
TMC102-E125--240.05

TMD101-E121--240.06
TMD102-E123--240.06
TMD103-E124--240.06
TMC102-E125--240.06

2  SHEET B 是資料庫裡的檔案,本來就有的 ,當a sheet抓出來之後(如上題),要去比對b sheet的資料(part_id 和ope_no欄位),如果確定資料符合就會寫入B1欄位(如B1),但是在B sheet裡面PARTID會有一些只有前六碼符合的資料(如綠色標記),也要將他視為資料符合 這邊的話 不知道怎麼改@@?

3 B1 Sheet的 item0~item3 是當check過a sheet 和b sheet之後 如果資料符合,要將b sheet裡符合的資料 copy 到b1,  item4 則是從a的spec id 抓過來(如紫色標記),請問我該怎麼寫?

以上 謝謝各位的教導~~
作者: GBKEE    時間: 2011-8-4 17:11

回復 24# ffntldj
試試看
  1. Sub Ex()
  2.     Dim f As Range, f1 As Range, Rng As Range, Ar, E As Range, S1 As Integer, S2 As Integer
  3.     Dim d1 As Object, d2 As Object
  4.     Set d1 = CreateObject("scripting.dictionary")   'Ans:2 -的物件
  5.     Set d2 = CreateObject("scripting.dictionary")   'Ans:3 -的物件
  6.     With Sheets("A")                                'Ans:1 -----
  7.         Set f = .Range("A1")                        '第一個"Mod part"
  8.         Do
  9.             Set f1 = .Columns(1).Find(What:="ACTION", MatchCase:=False, After:=f)   '從 Mod part 往下找"ACTION"
  10.             S1 = Application.Match("OPE_NO", f1.EntireRow, 0)                       'ACTION列 找到"OPE_NO"欄位
  11.             S2 = Application.Match("SPEC ID", f1.EntireRow, 0)                      'ACTION列 找到"SPEC ID"欄位
  12.             Set Rng = .Range(f.Offset(1), f1.Offset(-1))                            'Mod part - ACTION"之間的儲存格
  13.             Do
  14.                 If f1 Like "MODIFY*" Then
  15.                     For Each E In Rng
  16.                         d1(Split(E, "-")(0)) = d1(Split(E, "-")(0)) & "," & f1(1, S1).Value     'Split(E, "-")(0) 前六碼(KEY) 寫入"OPE_NO"(ITEM)
  17.                         d2(E.Value) = f1(1, S2).Value                                           'MODIFY*(KEY) 寫入"SPEC ID"(ITEM)
  18.                     Next
  19.                 End If
  20.                 Set f1 = f1.Offset(1)
  21.             Loop Until (f1 = "" And f1.End(xlDown).Row = Rows.Count) Or f1.Value = f.Value
  22.             Set f = .Columns(1).Find(What:=f, MatchCase:=False, After:=f)   '往下 尋找"Mod part"
  23.         Loop Until f.Address = "$A$1"                                       '回到第一個"Mod part"時離開迴圈
  24.     End With                                                                            'Ans:1 -----End
  25.     S1 = 0
  26.     ReDim Ar(4, S1)                  '製定 寫入B1陣列的欄位 5欄(0-4)
  27.     With Sheets("B")
  28.         S2 = 2
  29.         Do
  30.             If InStr(d1(Split(.Cells(S2, 1), "-")(0)), .Cells(S2, 2)) Then
  31.             'a sheet抓出來之後(如上題),要去比對b sheet的資料(part_id 和ope_no欄位),如果確定資料符合就會寫入B1欄位
  32.                 Ar(0, UBound(Ar, 2)) = .Cells(S2, 1)            'Ans:2 -----
  33.                 Ar(1, UBound(Ar, 2)) = .Cells(S2, 2)            'Ans:2 -----
  34.                 Ar(2, UBound(Ar, 2)) = .Cells(S2, 3)            'Ans:2 -----
  35.                 Ar(3, UBound(Ar, 2)) = .Cells(S2, 4)            'Ans:2 -----
  36.                 Ar(4, UBound(Ar, 2)) = d2(.Cells(S2, 1).Value)  'Ans:3 -----
  37.                 ReDim Preserve Ar(4, UBound(Ar, 2) + 1)
  38.             End If
  39.             S2 = S2 + 1
  40.         Loop Until .Cells(S2, 1) = ""                           '空白時離開迴圈
  41.     End With
  42.     With Sheets("B1")
  43.         .UsedRange.Offset(1).Clear
  44.         .[A2].Resize(UBound(Ar, 2), 5) = Application.Transpose(Ar)
  45.     End With
  46.     Set Rng = Nothing
  47.     Set E = Nothing
  48.     Set f = Nothing
  49.     Set f1 = Nothing
  50.     Set d1 = Nothing
  51.     Set d2 = Nothing
  52. End Sub
複製代碼




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