返回列表 上一主題 發帖

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

GBKEE

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

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

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2011-7-20 14:20 | 顯示全部帖子
回復 4# ffntldj
還是不清楚 ,範例請不要隨便列舉

TOP

GBKEE

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

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

GBKEE

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

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

GBKEE

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

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

GBKEE

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

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

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題