返回列表 上一主題 發帖

[發問] 轉換文字形式搜尋

[發問] 轉換文字形式搜尋

如何公式將文字的形式轉換,然後去搜尋對照的料號呢?

謝謝

活頁簿2.rar (10.26 KB)

本帖最後由 Andy2483 於 2023-3-17 14:55 編輯

回復 1# wayne0303
回復 39# 准提部林


    謝謝前輩
後學藉此帖學習到很多知識,以下是學習心得註解,請前輩再指教

執行前:


執行結果:



Sub TEST_A1()
Dim Arr, A, V, xD, T$, PH$, FN$, X%
Dim xB As Workbook, xS As Worksheet, xU As Range, xR As Range
'↑宣告變數:(Arr,A,V,xD)是通用型變數,(T,PH,FN)是字串變數,X是短整數變數
'xB是活頁簿變數,xS是工作表變數,(xU,xR)是儲存格變數

PH = ThisWorkbook.Path & "\"
'↑令PH這字串變數是 本檔所在資料夾名稱連接"\"組成的新字串
FN = "參數對照表.xls"
'↑令FN這字串變數是 "參數對照表.xls"字串
On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0
'檢查檔案是否已手動開啟中
'↑令程序執行遇到錯誤時,就跳到下個程序繼續執行
'令xB這活頁簿變數是 名字為FN變數的 活頁簿,
'如果FN("參數對照表.xls")這活頁簿沒有被開啟時,xB變數就抓不到這檔案,
'程序就會產生錯誤
'(這是為了當該檔案被開啟時,執行該程式能順利進行)
'On Error GoTo 0:令恢復程序偵錯

If xB Is Nothing Then
'若檔案尚未開啟, 由程式開啟
'↑如果xB變數還沒有納入物件(活頁簿還沒被開啟的意思)?

   If Dir(PH & FN) = "" Then MsgBox "指定檔案不存在!  ": Exit Sub
   '↑如果以PH變數連接FN變數組成的新字串,以Dir函數回傳值是空字元?
   '就跳出提視窗"~~~",然後按確定結束程式執行

   Application.ScreenUpdating = False
   '↑令螢幕畫面暫時不隨程序執行作結果的變化
   Set xB = Workbooks.Open(PH & FN)
   '由程式開啟檔案
   '↑令以PH變數連接FN變數組成的新字串(路徑+檔名+副檔名)開啟檔案

   X = 1
   '若檔案由程式開啟的, X標示為1
   '↑令X這短整數變數是 1

End If
Set xU = xB.Sheets("工作表1").[a2:az999]
'↑令xU這儲存格變數是 xB活頁簿中 名為"工作表1"工作表,
'工作表中的[a2:az999]儲存格 (物件變數)
'---------------------------------

Set xD = CreateObject("Scripting.Dictionary")
'↑令xD這通用型變數是 字典
For Each A In Array("平彎", "右螺旋", "左螺旋")
'↑設逐項迴圈!令A這通用型變數是 陣列值之一,
'陣列值:"平彎", "右螺旋", "左螺旋"這三個字串

    For Each xR In xU.Find(A, Lookat:=xlWhole).Resize(1, 100)
    '↑設內逐項迴圈!令xR這儲存格變數是 xU變數的Find()回傳儲存格,
    '向右擴展100格範圍的儲存格
    'PS.xU變數的Find()回傳儲存格:以A變數順逐格搜尋xU變數裡,
    '儲存格內容全同A變數的儲存格 (xlWhole是全同,xlPart是包含同)

        If xR(3) <> "" Then xD(V & xR(3)) = xR(2)
        '↑如果xR變數算起的第3格值不是 空字元!
        '就令以V這通用型變數連接 xR變數算起的第3格值當key,
        'item是 xR變數算起的第2格值納入xD字典裡

    Next
    V = V + 1
    '↑令V這通用型變數累加1
Next
If X = 1 Then xB.Close 0
'若檔案由程式開啟的, 則自動關閉它
'↑如果X變數是 1!就令xB變數(參數對照表.xls檔案)不存檔關閉
'如果程式執行前就已經開啟的,則不會關閉檔案

Set xB = Nothing
'↑令xB變數釋放掉物件
'---------------------------

Arr = Range([a1], [a65536].End(3))
'↑令Arr這通用型變數是 二維陣列,
'以[A1]到A欄最後有內容儲存格之間的儲存格值帶入陣列中

For i = 1 To UBound(Arr)
'↑設順迴圈!i從1到Arr陣列縱向最大索引列號
    T = Replace(Replace(Arr(i, 1), "°", ""), "仰角", "/")
    '↑令T這字串變數是 i迴圈列第1欄Arr陣列值經過兩次文字置換的新字串,
    '第1次置換:"°" 換 ""
    '第2次置換:"仰角" 換 "/"

    T = Split(Replace(Replace(T, "RR", "1R"), "LR", "2R") & "轉", "轉")(0)
    '↑令T變數是 Split()以 "轉"字元分割 (T變數經過兩次置換字串後的新字串),
    '分割後的一維陣列中第0索引號陣列值
    '第1次置換:"RR" 換 "1R"
    '第2次置換:"LR" 換 "2R"
    '這兩個置換是必需與字典key對照的:1是右螺旋,2是左螺旋

   
    'PS:置換後的字串後方連接 "轉"成新字串後才分割!
    '後學好像知道為什麼了:
    '為了萬一T裡沒有 "轉"字,指向的陣列所引號是(1),
    '會造成錯誤(陣列索引超出範圍)
    '連接 "轉"後分割的陣列最後一個值是空字元,被引用也不影響其結果
    '所以養成習慣:在分割前於其目標字串後方多加一個分割字

    Arr(i, 1) = xD(T)
    '↑令i迴圈列第1欄Arr陣列值是 T變數在Y字典裡的item值
Next i
[b1].Resize(UBound(Arr)) = Arr
'↑令[B1]擴展向下Arr陣列縱向最大索引列號數儲存格值,以Arr陣列值帶入
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 41# 准提部林

回復  wayne0303

問題1: 可能範圍有誤
Set xU = xB.Sheets("工作表1").[a2:az999]
改成
Set xU = xB ...
准提部林 發表於 2021-9-14 16:55



換成cells就ok了。
終於可以用了!!感謝准大的幫忙~~~

TOP

回復 40# wayne0303

問題1: 可能範圍有誤
Set xU = xB.Sheets("工作表1").[a2:az999]
改成
Set xU = xB.Sheets("工作表1").CELLS

問題2:
可能是找不到 "平彎", "右螺旋", "左螺旋" 這三個文字???
自行去確定文字是否存在, 或完全一樣

TOP

本帖最後由 wayne0303 於 2021-9-14 13:21 編輯

回復 39# 准提部林


准大,我照改馬塞克部分,就變成這樣了...
(100是夠用的)

2021-09-14_125940_New.jpg (71.15 KB)

2021-09-14_125940_New.jpg

TOP

回復 38# wayne0303

參考檔:
TEST001.rar (27.31 KB)

TOP

本帖最後由 wayne0303 於 2021-9-14 01:06 編輯

回復 37# 准提部林


報告准大~內部表格可以,但……

Set xU = [工作表1!d:w] '若是跨檔, 必須先打開該檔案, 再指定工作表及範圍 >>跨檔這個照您說的打開該檔,也指定工作表名稱跟範圍測試會出現'424吔...

2021-09-14_005855.jpg (14.77 KB)

2021-09-14_005855.jpg

TOP

本帖最後由 准提部林 於 2021-9-13 18:59 編輯

回復 36# wayne0303

Sub TEST_A1()
Dim xU As Range, Arr, A, V, xR As Range, xD, T$
Set xD = CreateObject("Scripting.Dictionary")
Set xU = [工作表1!f2:ad73]
For Each A In Array("平彎", "右螺旋", "左螺旋")
    For Each xR In xU.Find(A, Lookat:=xlWhole).Resize(1, 100)  '找到關鍵字, 向右擴展100欄, 若不夠用自改下(此時就不用管合併格了)  
        If xR(3) <> "" Then xD(V & xR(3)) = xR(2)
    Next
    V = V + 1
Next
'---------------------------
Arr = Range([a1], [a65536].End(3))
For i = 1 To UBound(Arr)  'A欄資料由第一行開始, 要改成 FOR I=1 TO ??   
    T = Replace(Replace(Arr(i, 1), "°", ""), "仰角", "/")
    T = Split(Replace(Replace(T, "RR", "1R"), "LR", "2R") & "轉", "轉")(0)
    Arr(i, 1) = xD(T) '同行寫入, 這就不須再用 i-4   
Next i
[b1].Resize(UBound(Arr)) = Arr  '結果資料置入, 須同步從B1下手   
End Sub


==========================================

TOP

回復 33# 准提部林


准大我試了您的代碼只搜出最後一個R390的品號,再麻煩您有空看一下是我範圍設錯了嗎?
然後請忽略35#的發言~


謝謝~

轉換文字形式搜尋_例.rar (22.69 KB)

TOP

回復 33# 准提部林


For Each xR In xU.Find(A, Lookat:=xlWhole).MergeArea   '注意:這是以"合併格"抓範圍>>可是准大這樣還必須複製到其它地方合併,比較希望能用原表格型式搜尋...

TOP

        靜思自在 : 有願放在心裡,沒有身體力行,正如耕田不播種,皆是空過因緣。
返回列表 上一主題