返回列表 上一主題 發帖

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

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
1# 跳轉到 »
發表於 2021-9-11 10:48 | 顯示全部帖子
純文字處理~~~

Sub TEST_A1()
Dim xU As Range, Arr, A, V, xR As Range, xD, T$
Set xD = CreateObject("Scripting.Dictionary")
Set xU = [工作表1!d:w] '若是跨檔, 必須先打開該檔案, 再指定工作表及範圍
For Each A In Array("平彎", "右螺旋", "左螺旋")     
      For Each xR In xU.Find(A, Lookat:=xlWhole).MergeArea   '注意:這是以"合併格"抓範圍
           xD(V & xR(3)) = xR(2)
    Next
    V = V + 1
Next
'---------------------------
Arr = Range([a1], [a65536].End(3))
For i = 5 To UBound(Arr)
    T = Replace(Replace(Arr(i, 1), "°", ""), "仰角", "/")
    T = Split(Replace(Replace(T, "RR", "1R"), "LR", "2R") & "轉", "轉")(0)
    Arr(i - 4, 1) = xD(T)
Next i
[b5].Resize(UBound(Arr) - 4) = Arr
End Sub


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

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
2#
發表於 2021-9-13 18:57 | 顯示全部帖子
本帖最後由 准提部林 於 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

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
3#
發表於 2021-9-14 10:35 | 顯示全部帖子
回復 38# wayne0303

參考檔:
TEST001.rar (27.31 KB)

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
4#
發表於 2021-9-14 16:55 | 顯示全部帖子
回復 40# wayne0303

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

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

TOP

        靜思自在 : 【時日莫空過】一個人在世間做了多少事，就等於壽命有多長。因此必須與時間競爭，切莫使時日空過。
返回列表 上一主題