麻辣家族討論版版 - Powered by Discuz! Board

標題: VBA如何比對儲存格特定字串 [打印本頁]

作者: lumark1976 時間: 2022-11-28 17:53 標題: VBA如何比對儲存格特定字串

請問VBA如何將B2~B27欄字串依序模糊比對G欄字串，有符合則複制字串貼上C欄，謝謝大大解答
[attach]35535[/attach]

作者: samwang 時間: 2022-11-29 08:07

回復 1# lumark1976

請問這有比較明確規則嗎?
1. 因為shielding 要找shiel 或 shieldi 或 shildin .... ，
2. SCREW(M3*6) 要找 SCREW M3 或 SCREW M3*6 ....，

作者: lumark1976 時間: 2022-11-29 08:39

本帖最後由 lumark1976 於 2022-11-29 08:42 編輯

Sam大大，如果比對出有與G欄一樣的字串就好，有辦法做到嗎？感謝！！

作者: samwang 時間: 2022-11-29 09:03

Sam大大，如果比對出有與G欄一樣的字串就好，有辦法做到嗎？感謝！！
lumark1976 發表於 2022-11-29 08:39

請測試看看，謝謝
Sub test()
Dim Arr, Brr, T$, i&, i2&
Arr = Range([c1], [b65536].End(3))
Brr = Range([g1], [g65536].End(3))
For i = 2 To UBound(Brr)
T = UCase(Brr(i, 1)): If T = "" Then GoTo 99
For i2 = 2 To UBound(Arr)
      If InStr(UCase(Arr(i2, 1)), T) Then
         Arr(i2, 2) = Brr(i, 1)
      End If
Next
99: Next
[b1].Resize(UBound(Arr), 2) = Arr
End Sub

作者: lumark1976 時間: 2022-11-29 09:25

感謝大大，可以了，再次感謝

作者: lumark1976 時間: 2022-11-29 09:44

回復 4# samwang

大大，我是初學者，可以註解說明一下你寫的程式碼嗎，感激不盡！！:)

作者: samwang 時間: 2022-11-29 13:13

回復 samwang

大大，我是初學者，可以註解說明一下你寫的程式碼嗎，感激不盡！！
lumark1976 發表於 2022-11-29 09:44

Sub test()
Dim Arr, Brr, T$, i&, i2&
Arr = Range([c1], [b65536].End(3)) 'B、C欄資料裝入Arr
Brr = Range([g1], [g65536].End(3)) 'G欄資料裝入Brr
For i = 2 To UBound(Brr)
T = UCase(Brr(i, 1)): If T = "" Then GoTo 99 '無資料換下一個
For i2 = 2 To UBound(Arr)
      If InStr(UCase(Arr(i2, 1)), T) Then '比對G欄資料有無在B欄
         Arr(i2, 2) = Brr(i, 1) '有時，G欄資料寫入到Arr
      End If
Next
99: Next
[b1].Resize(UBound(Arr), 2) = Arr  'Arr貼回excel
End Sub

作者: Andy2483 時間: 2022-11-29 16:44

回復 1# lumark1976

謝謝前輩發表此主題與範例
這種產品的敘述要歸類超麻煩!
請前輩試試看!
就此範例練習陣列與字典
執行結果:
[attach]35543[/attach]

Option Explicit
Sub TEST_2()
Dim Brr, Grr, Crr, C&, i&, x$, xR, R&, T, V, Y, Z
Dim Sh, Q$(5), A$(5), j&
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = Sheets("PN標準工時")
Brr = Range(Sh.[B2], Sh.Cells(Rows.Count, "B").End(3))
Grr = Range(Sh.[G2], Sh.Cells(Rows.Count, "G").End(3))
ReDim Crr(1 To UBound(Brr), 1 To 1)
For i = 1 To UBound(Grr)
xR = Replace(Replace(Replace(UCase(Grr(i, 1)), "(", "*"), ")", "*"), " ", "*")
Y(xR) = Grr(i, 1)
Next
Q(1) = UCase("CONN POWER JACK")
A(1) = UCase("POWER JACK")
Q(2) = UCase("CONN RJ45")
A(2) = UCase("RJ45")
Q(3) = UCase("Shield")
A(3) = UCase("Shielding")
For Each xR In Y.Keys
For i = 1 To UBound(Brr)
   If Crr(i, 1) <> "" Then
      GoTo 111
   End If
   x = UCase(Brr(i, 1))
   For j = 1 To 3
      x = Replace(x, Q(j), A(j))
   Next
   If x Like "*" & xR & "*" Then
      Crr(i, 1) = Y(xR)
   End If

111
Next
Next
Sh.[C2].Resize(UBound(Crr), 1) = Crr
Set Brr = Nothing
Set Grr = Nothing
End Sub

作者: Andy2483 時間: 2022-11-30 09:24

謝謝論壇!謝謝前輩們
希望能幫忙到樓主前輩!後學在此主題學習到很多知識!
心得註解如下,請前輩們再指導!謝謝

Option Explicit
Sub TEST_2()
Dim Brr, Grr, Crr, C&, i&, x$, xR, R&, T, V, Y, Z
Dim Sh, Q$(5), A$(5), j&
'↑宣告變數,Q$(5)是批次宣告從Q(0)~Q(5), A$(5)類推
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y是字典
Set Sh = Sheets("PN標準工時")
'↑令Sh 是工作表
Brr = Range(Sh.[B2], Sh.Cells(Rows.Count, "B").End(3))
'↑令Brr 是陣列!倒入工作表[B2]到B欄最後有內容的儲存格的值
Grr = Range(Sh.[G2], Sh.Cells(Rows.Count, "G").End(3))
'↑令Grr 是陣列!倒入工作表[G2]到G欄最後有內容的儲存格的值
ReDim Crr(1 To UBound(Brr), 1 To 1)
'↑宣告Crr陣列的範圍!縱向從1到Brr陣列縱向最大列號,橫向從1到1欄
For i = 1 To UBound(Grr)
'↑設順迴圈!i從1到 Grr陣列縱向最大列號
xR = Replace(Replace(Replace(UCase(Grr(i, 1)), "(", "*"), ")", "*"), " ", "*")
'↑令xR 是迴圈Grr陣列值經英文字轉大寫再將 "(" ,")" ," ",這三個字元置換為"*"字元的字串新值
Y(xR) = Grr(i, 1)
'↑令xR 當key,迴圈Grr陣列值當item
Next
Q(1) = UCase("CONN POWER JACK")
'↑令第二個Q字串變數是將雙引號內文字的英文字置換為大寫後的新字串
A(1) = UCase("POWER JACK")
'↑令第二個A字串變數是將雙引號內文字的英文字置換為大寫後的新字串
Q(2) = UCase("CONN RJ45")
'↑類推
A(2) = UCase("RJ45")
'↑類推
Q(3) = UCase("Shield")
'↑類推
A(3) = UCase("Shielding")
'↑類推
For Each xR In Y.Keys
'↑設外順迴圈!令xR是 Y字典裡key的一員
For i = 1 To UBound(Brr)
'↑設中順迴圈!i從1 到Brr陣列縱向最大列號
   If Crr(i, 1) <> "" Then
   '↑如果迴圈Crr陣列值不是空字元
      GoTo 111
      '↑跳到 111位置繼續執行,代表已經處理過!有值了
   End If
   x = UCase(Brr(i, 1))
   '↑令x是迴圈Brr陣列值經英文字置換為大寫後的新字串
   For j = 1 To 3
   '↑設內順迴圈!j從1 到3
      x = Replace(x, Q(j), A(j))
      '↑令x是 x經過Q字串變數置換為 A字串變數的新字串
   Next
   If x Like "*" & xR & "*" Then
   '↑如果經過處理過的 x新字串吻合 xR這key結合前後包夾一個*萬字元的邏輯判斷??
      Crr(i, 1) = Y(xR)
      '↑如果if條件成立!就讓迴圈Crr陣列值以 xR字串變數當key查察Y字典的item帶入
   End If

111
Next
Next
Sh.[C2].Resize(UBound(Crr), 1) = Crr
'↑工作表的[C2]儲存格擴展向下 Crr陣列縱向最大列號數,左右沒再擴展的儲存格範圍,
'倒入Crr陣列的值
Set Brr = Nothing
Set Grr = Nothing
Set Crr = Nothing
Set Y = Nothing
'↑把這些容器從記憶體中釋放掉
End Sub

作者: lumark1976 時間: 2022-11-30 13:12

回復 9# Andy2483

:) 哇，真的太棒了，真的太感謝您了！！

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