123
返回列表 上一主題 發帖

不好意思 新手又來請教 資料比對問題 麻煩各位了

ffntldj

帖子
26 
主題
6 
精華
0 
積分
33 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-7-19 
最後登錄
2013-5-13 

論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 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所示)
   

附件如下   再麻煩大家了 真是不好意思 Book1.rar (2.57 KB)
收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
25#
發表於 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
複製代碼

TOP

ffntldj

帖子
26 
主題
6 
精華
0 
積分
33 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-7-19 
最後登錄
2013-5-13 

論壇贊助勳章
24#
發表於 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 抓過來(如紫色標記),請問我該怎麼寫?

以上 謝謝各位的教導~~

ScreenHunter_06 Aug. 01 22.37.gif (69.23 KB)

ScreenHunter_06 Aug. 01 22.37.gif

ScreenHunter_07 Aug. 01 22.40.gif (46.79 KB)

ScreenHunter_07 Aug. 01 22.40.gif

Book1.rar (4.76 KB)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
23#
發表於 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) 你可慢慢體會.

TOP

ffntldj

帖子
26 
主題
6 
精華
0 
積分
33 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-7-19 
最後登錄
2013-5-13 

論壇贊助勳章
22#
發表於 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)

不知道這樣的描述看的懂嘛 謝謝版主

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
21#
發表於 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
複製代碼

TOP

ffntldj

帖子
26 
主題
6 
精華
0 
積分
33 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-7-19 
最後登錄
2013-5-13 

論壇贊助勳章
20#
發表於 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裡面的值時 ,也要把它抓出來的話 該怎麼做? 這我真的就不會了~~

以上 謝謝

TOP

ffntldj

帖子
26 
主題
6 
精華
0 
積分
33 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-7-19 
最後登錄
2013-5-13 

論壇贊助勳章
19#
發表於 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欄位
抱歉  程式碼我研究一下

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
18#
發表於 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
複製代碼

TOP

ffntldj

帖子
26 
主題
6 
精華
0 
積分
33 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-7-19 
最後登錄
2013-5-13 

論壇贊助勳章
17#
發表於 2011-7-22 00:29 | 只看該作者
本帖最後由 ffntldj 於 2011-7-22 23:18 編輯

回復 15# Hsieh

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

如下

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

就可以用滑鼠點檔案了

感謝版主~

TOP

        靜思自在 : 成功是優點的發揮，失敗是缺點的累積。
123
返回列表 上一主題