GBKEE

回復 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

GBKEE

回復 4# ffntldj
還是不清楚 ,範例請不要隨便列舉

GBKEE

回復 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

複製代碼

GBKEE

回復 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

複製代碼

GBKEE

回復 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) 你可慢慢體會.

GBKEE

回復 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

複製代碼