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

標題: [發問] 轉換文字形式搜尋 [打印本頁]

作者: wayne0303 時間: 2021-8-20 14:53 標題: 轉換文字形式搜尋

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

謝謝

作者: samwang 時間: 2021-8-21 00:09

回復 1# wayne0303

不好意思看不太懂，可否解釋詳細一點，謝謝

作者: wayne0303 時間: 2021-8-21 00:54

回復 2# samwang

抱歉！samwang大

LR220仰角25°轉180° →LR220/25 對照表格為左螺旋底下的213
RR230仰角30°轉180° →RR230/30 對照表格為右螺旋底下的124
RR230仰角20°轉180° →RR230/20 對照表格為右螺旋底下的122
R390轉90°→R390 對照表格為平彎底下的318

用公式找出對照出來的213、124、122、318...這些數字

這樣...不知道您能看得懂嗎(汗)

作者: samwang 時間: 2021-8-21 09:14

回復 3# wayne0303

請測試看看，謝謝

Sub test()
Dim Arr, xD, T$, w1$, w2$, i&, j&, k%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range("d3:w16")
For i = 2 To UBound(Arr) Step 6
k = k + 1
For j = 1 To UBound(Arr, 2)
      T = Arr(i, j): If T = "" Then GoTo 99
      xD(T & "_" & k) = Arr(i - 1, j)
Next j
99: Next i
Arr = Range("a5:a" & [a5].End(4).Row)
For i = 1 To UBound(Arr)
w1 = Left(Arr(i, 1), 1)
w2 = Mid(Arr(i, 1), 2, 1)
If Asc(w1) > 64 And Asc(w1) < 123 And Asc(w2) > 64 And Asc(w2) < 123 Then
      If UCase(w1) = "L" Then
         T = Mid(Arr(i, 1), 2, 4) & "/" & Mid(Arr(i, 1), 8, 2) & "_" & 2
         Arr(i, 1) = xD(T)
      End If
      If UCase(w1) = "R" Then
         T = Mid(Arr(i, 1), 2, 4) & "/" & Mid(Arr(i, 1), 8, 2) & "_" & 1
         Arr(i, 1) = xD(T)
      End If
Else
      T = Left(Arr(i, 1), 4) & "_" & 3
      Arr(i, 1) = xD(T)
End If
Next
Range("b5").Resize(UBound(Arr)) = Arr
End Sub

作者: hcm19522 時間: 2021-8-21 10:55

C5=OFFSET(C$1,IF(LEFT(A5)="L",8,IF(LEFT(A5,2)="RR",2,14)),MATCH(MID(SUBSTITUTE(A5,"仰角","/"),1+(MID(A5,2,1)="R"),4+(MID(A5,2,1)="R")*3),OFFSET(D$1,IF(LEFT(A5)="L",9,IF(LEFT(A5,2)="RR",3,15)),,,20),))

作者: wayne0303 時間: 2021-8-21 13:57

回復 5# hcm19522

請教hcm19522大！

我是取其它工作表的資料搜尋
引用C$1、D$1會有影響嗎？因為我會出現#N/A...

作者: wayne0303 時間: 2021-8-21 14:31

回復 4# samwang

感謝samwang大大幫忙！！

作者: wayne0303 時間: 2021-8-21 14:34

回復 hcm19522

請教hcm19522大！

我是取其它工作表的資料搜尋
引用C$1、D$1會有影響嗎？因為我會出 ...
wayne0303 發表於 2021-8-21 13:57

謝謝hcm19522大大！

不好意思，我看懂了

謝謝您的幫忙！！

作者: wayne0303 時間: 2021-8-21 14:48

回復 5# hcm19522

不好意思要再請問一下hcm19522大！如果我的數字會到4位數那公式要怎麼改寫呢？

謝謝

作者: wayne0303 時間: 2021-8-22 20:26

如果是引用其它工作表為搜尋資料的情況下，有其它公式的寫法嗎？
R後數字為3~4位數

(用OFFSET的公式，必需開啟引用的工作表，不然會出現#VALUE!)

作者: wayne0303 時間: 2021-8-30 23:54

本帖最後由 wayne0303 於 2021-8-31 00:09 編輯

回復 4# samwang

報告samwang大！
我執行完沒東西吔...

R是3~4位數字

作者: samwang 時間: 2021-8-31 07:17

本帖最後由 samwang 於 2021-8-31 07:19 編輯

回復 samwang

報告samwang大！
我執行完沒東西吔...

R是3~4位數字
wayne0303 發表於 2021-8-30 23:54

如附件圖片，我執行沒問題依據4#程式碼，結果在B欄，請再確認，謝謝。

作者: wayne0303 時間: 2021-8-31 08:42

回復 12# samwang

感謝samwang大！但
1.如圖現在遇到仰角是個位數字跟R為4位數字就搜尋不到
2.如果我的表格是必需引用到外部的表格那我要改代碼的哪邊呢？
3.用"模組"的話有辦法按個滑鼠的右鍵或左鍵就更新數值或是數值有變更就可立即更新數值(不需關掉檔案再開)？

謝謝

作者: samwang 時間: 2021-8-31 10:22

回復 13# wayne0303

請再測試看看，謝謝

1.如圖現在遇到仰角是個位數字跟R為4位數字就搜尋不到 >> 已更新如附件
2.如果我的表格是必需引用到外部的表格那我要改代碼的哪邊呢？ >> 程式碼有備註需要更改的地方(第1段)
3.用"模組"的話有辦法按個滑鼠的右鍵或左鍵就更新數值或是數值有變更就可立即更新數值(不需關掉檔案再開)？ >>已更新，當A5~A65536有更新會自動更新

作者: ML089 時間: 2021-8-31 11:25

C5 陣列公式
=MAX(IF(SUBSTITUTE(SUBSTITUTE(LEFT(A5,FIND("轉",A5)-1),"仰角","/"),"°",)=({"R";0;0;0;0;0;"L";0;0;0;0;0;""}&D$4:W$16),D$3:W$15))

作者: wayne0303 時間: 2021-8-31 14:22

回復 15# ML089

感謝ML089大大的超簡潔公式~
但我引用外部表格的時候會出現#N/A

作者: ML089 時間: 2021-8-31 18:09

回復 16# wayne0303

公式就是麻煩，只要移動一下就需要修改

最好資料位置，公式位置要跟你元資料一樣，這拿回去才能直接套用。

先試試放入你原先的樣本EXCEL是否OK

真的不會改再重新PO一下目前的資料格式

作者: wayne0303 時間: 2021-8-31 18:28

回復 17# ML089

回復 wayne0303

公式就是麻煩，只要移動一下就需要修改

最好資料位置，公式位置要跟你元資料一樣， ...
ML089 發表於 2021-8-31 18:09

哈哈~ML089大大，公式是比較好了解啦，不然我ｖｂａ完全苦手，沒基底也看不太懂...
我剛試改了一下可以套用了

非常謝謝大大幫忙~

作者: wayne0303 時間: 2021-8-31 19:37

回復 14# samwang

samwang大大~

2.如果我的表格是必需引用到外部的表格那我要改代碼的哪邊呢？這個部分例如我要引用的外部表格在D:\資料夾123\活頁簿abc 裡的 "d3:w16" 這個範圍該怎麼寫呢？

謝謝

作者: samwang 時間: 2021-9-1 07:11

回復 samwang

samwang大大~

2.如果我的表格是必需引用到外部的表格那我要改代碼的哪邊呢？這個 ...
wayne0303 發表於 2021-8-31 19:37

修改如紅字部分，請測試看看，謝謝
Sub 更新()
Dim Arr, xD, T1$, T2$, T$, w1$, w2$, i&, j&, k%
Set xD = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set WB = Workbooks.Open("D:\資料夾123\活頁簿abc.xlsx")
Arr = Range("d3:w16")
WB.Close

For i = 2 To UBound(Arr) Step 6
k = k + 1
For j = 1 To UBound(Arr, 2)
T = Arr(i, j): If T = "" Then GoTo 99
xD(T & "_" & k) = Arr(i - 1, j)
Next j
99: Next i
....
...
....

作者: wayne0303 時間: 2021-9-1 12:18

回復 20# samwang

非常感謝samwang大大不厭其煩的幫忙！

作者: wayne0303 時間: 2021-9-9 16:42

本帖最後由 wayne0303 於 2021-9-9 16:56 編輯

回復 20# samwang

samwang大又有問題了~
我的欄列都會(不對等的)增加
我修改了代碼(紅字)範圍部分但好像沒作用...
應該要再改哪邊呢？

Sub 更新()
Dim Arr, xD, T1$, T2$, T$, w1$, w2$, i&, j&, k%
Set xD = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set WB = Workbooks.Open("D:\資料夾123\活頁簿abc.xlsx")
Arr = Range("d3:w16")
WB.Close

For i = 2 To UBound(Arr) Step 6
k = k + 1
For j = 1 To UBound(Arr, 2)
T = Arr(i, j): If T = "" Then GoTo 99
xD(T & "_" & k) = Arr(i - 1, j)
Next j
99: Next i
....
...
....

還有連結外部表格的時候會出現執行階段錯誤'1004':

謝謝

作者: samwang 時間: 2021-9-9 17:31

回復 22# wayne0303

我的欄列都會(不對等的)增加 >> 可以提供實際案例範例，且說明何謂不對等增加? 謝謝

還有連結外部表格的時候會出現執行階段錯誤'1004': >> 請提供範例，謝謝

作者: wayne0303 時間: 2021-9-9 19:41

本帖最後由 wayne0303 於 2021-9-9 19:55 編輯

回復 23# samwang

回復 wayne0303

我的欄列都會(不對等的)增加 >> 可以提供實際案例範例，且說明何謂不對等增加? 謝謝
, ↑↑↑不好意思我是指工作上會需要增加
...
samwang 發表於 2021-9-9 17:31

還有連結外部表格的時候會出現執行階段錯誤'1004': >> 請提供範例，謝謝
我就是把這邊的路徑改成公司的區網裡的檔案路徑而已Set WB = Workbooks.Open("公司路徑")，這個我也不知道怎麼提供範例...不能解就這樣吧

謝謝samwang大~

作者: samwang 時間: 2021-9-9 20:30

回復 24# wayne0303

我的欄列都會(不對等的)增加
>>請問您的資料是從K欄開始嗎? 3個資料的中間不會有其它的資料對吧?

我就是把這邊的路徑改成公司的區網裡的檔案路徑而已Set WB = Workbooks.Open("公司路徑")
>>如您寫的Set WB = Workbooks.Open("公司路徑")，公司路徑就換成實際的路徑即可

作者: wayne0303 時間: 2021-9-10 08:19

回復 25# samwang

我的欄列都會(不對等的)增加
>>請問您的資料是從K欄開始嗎? 3個資料的中間不會有其它的資料對吧?>>如附件，實際是從D欄開始

我就是把這邊的路徑改成公司的區網裡的檔案路徑而已Set WB = Workbooks.Open("公司路徑")
>>如您寫的Set WB = Workbooks.Open("公司路徑")，公司路徑就換成實際的路徑即可>>公司路徑就是檔案放置的位置

作者: samwang 時間: 2021-9-10 09:34

回復 26# wayne0303

我就是把這邊的路徑改成公司的區網裡的檔案路徑而已Set WB = Workbooks.Open("公司路徑")
>>如您寫的Set WB = Workbooks.Open("公司路徑")，公司路徑就換成實際的路徑即可>>公司路徑就是檔案放置的位置
>> 檔名是......\活頁簿abc.xlsx，對嗎?

作者: wayne0303 時間: 2021-9-10 10:54

回復 27# samwang

我就是把這邊的路徑改成公司的區網裡的檔案路徑而已Set WB = Workbooks.Open("公司路徑")
>>如您寫的Set WB = Workbooks.Open("公司路徑")，公司路徑就換成實際的路徑即可>>公司路徑就是檔案放置的位置
>> 檔名是......\活頁簿abc.xlsx，對嗎? >> 檔名是......\○○○統計表.xlsx ←這樣

作者: samwang 時間: 2021-9-10 11:45

回復 28# wayne0303

請測試看看，謝謝

Sub test()
Dim Arr, xD, T1$, T2$, T$, w1$, w2$, i&, j&, k%, R%, C%
Set xD = CreateObject("Scripting.Dictionary")
Set fs = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False: Application.DisplayAlerts = False
FPath = ThisWorkbook.Path
Set WB = Workbooks.Open(FPath & "\統計表.xlsx")
With Sheets(1)
If .FilterMode Then .ShowAllData
R = Range("f65536").End(3).Row
C = Rows("3:" & R).Find("*", searchorder:=xlByColumns, SearchDirection:=xlPrevious).Column
Arr = Range([f1], Cells(R, C))
For i = 1 To UBound(Arr)
      If InStr(Arr(i, 1), "右螺") Then
         For j = 1 To UBound(Arr, 2)
            T = Arr(i + 2, j): If T = "" Then GoTo 95
            xD(T & "_1") = Arr(i + 1, j)
95:       Next
      ElseIf InStr(Arr(i, 1), "左螺") Then
         For j = 1 To UBound(Arr, 2)
            T = Arr(i + 2, j): If T = "" Then GoTo 96
            xD(T & "_2") = Arr(i + 1, j)
96:       Next
      ElseIf InStr(Arr(i, 1), "平") Then
         For j = 1 To UBound(Arr, 2)
            T = Arr(i + 2, j): If T = "" Then GoTo 97
            xD(T & "_3") = Arr(i + 1, j)
97:       Next
      End If
Next
End With
WB.Close
Arr = Range("a1:a" & [a65536].End(3).Row)
For i = 1 To UBound(Arr)
If Arr(i, 1) = "" Then GoTo 98
If Left(Arr(i, 1), 1) = "L" Or Left(Arr(i, 1), 1) = "R" Then
      w1 = Left(Arr(i, 1), 1): w2 = Mid(Arr(i, 1), 2, 1)
      If Asc(w1) > 64 And Asc(w1) < 123 And Asc(w2) > 64 And Asc(w2) < 123 Then
         If UCase(w1) = "L" Then
            T1 = Mid(Split(Arr(i, 1), "仰")(0), 2)
            T2 = Split(Split(Arr(i, 1), "角")(1), "°")(0)
            T = T1 & "/" & T2 & "_" & 2: Arr(i, 1) = xD(T)
         End If
         If UCase(w1) = "R" Then
            T1 = Mid(Split(Arr(i, 1), "仰")(0), 2)
            T2 = Split(Split(Arr(i, 1), "角")(1), "°")(0)
            T = T1 & "/" & T2 & "_" & 1: Arr(i, 1) = xD(T)
         End If
      Else
         T = Split(Arr(i, 1), "轉")(0) & "_" & 3: Arr(i, 1) = xD(T)
      End If
End If
98: Next
Range("b1").Resize(UBound(Arr)) = Arr
Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub

作者: wayne0303 時間: 2021-9-10 13:38

本帖最後由 wayne0303 於 2021-9-10 13:44 編輯

回復 29# samwang

連結會變成...找不到(如附圖)
把檔案複製到桌面可以執行但搜尋結果是空白...
所以問一下大大~
R = Range("f65536").End(3).Row >>這是表格起始位置？所以您這個代碼沒有設定表格搜尋範圍了？
Arr = Range("a1:a" & [a65536].End(3).Row)>>這是來源配對檔位置？

因為您這個代碼是設定連結外部表格搜尋，如果我要先用本身檔案測試與了解之後再套用外部的表格...那該改哪邊呢？

謝謝

作者: samwang 時間: 2021-9-10 14:17

回復 30# wayne0303

因為您這個代碼是設定連結外部表格搜尋，如果我要先用本身檔案測試與了解之後再套用外部的表格...那該改哪邊呢？
>> #20 就有說明過了，下面那3個移除即可
'FPath = ThisWorkbook.Path
'Set WB = Workbooks.Open(FPath & "\統計表.xlsx")
...
...
'WB.Close

作者: samwang 時間: 2021-9-10 14:43

本帖最後由 samwang 於 2021-9-10 14:46 編輯

回復 30# wayne0303

R = Range("f65536").End(3).Row >>這是表格起始位置？所以您這個代碼沒有設定表格搜尋範圍了？
Arr = Range("a1:a" & [a65536].End(3).Row)>>這是來源配對檔位置？
>> #29 程式碼，只有針對你提到"我的欄列都會(不對等的)增加" 做修改如下，還有比對時一小部分新增，已有寫註解了，請自行研究一下，謝謝

Application.ScreenUpdating = False: Application.DisplayAlerts = False
'FPath = ThisWorkbook.Path  '本檔案的路徑
'Set WB = Workbooks.Open(FPath & "\統計表.xlsx") '開啟本檔案路徑下的統計表
'''針對"我的欄列都會(不對等的)增加"的處理，
With Sheets(1)
If .FilterMode Then .ShowAllData
R = Range("f65536").End(3).Row  'F欄最後一列
C = Rows("3:" & R).Find("*", searchorder:=xlByColumns, SearchDirection:=xlPrevious).Column '找到最後一欄
Arr = Range([f1], Cells(R, C)) '資料裝入陣列
For i = 1 To UBound(Arr)
      If InStr(Arr(i, 1), "右螺") Then
         For j = 1 To UBound(Arr, 2)
            T = Arr(i + 2, j): If T = "" Then GoTo 95
            xD(T & "_1") = Arr(i + 1, j) '右螺旋資料裝到字典
95:       Next
      ElseIf InStr(Arr(i, 1), "左螺") Then
         For j = 1 To UBound(Arr, 2)
            T = Arr(i + 2, j): If T = "" Then GoTo 96
            xD(T & "_2") = Arr(i + 1, j) '左螺旋資料裝到字典
96:       Next
      ElseIf InStr(Arr(i, 1), "平") Then
         For j = 1 To UBound(Arr, 2)
            T = Arr(i + 2, j): If T = "" Then GoTo 97
            xD(T & "_3") = Arr(i + 1, j) '平彎資料裝到字典
97:       Next
      End If
Next
End With
'WB.Close '關閉統計表

'下面的上次的一樣，只有新增如下
Arr = Range("a1:a" & [a65536].End(3).Row) '要被比對的資料
For i = 1 To UBound(Arr)
If Arr(i, 1) = "" Then GoTo 98 '新增:當A欄的儲存格無資料不做動作
If Left(Arr(i, 1), 1) = "L" Or Left(Arr(i, 1), 1) = "R" Then 'A欄儲存格的第1個字"L" "R"才動作
      w1 = Left(Arr(i, 1), 1): w2 = Mid(Arr(i, 1), 2, 1)
      If Asc(w1) > 64 And Asc(w1) < 123 And Asc(w2) > 64 And Asc(w2) < 123 Then
....
...

作者: 准提部林 時間: 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

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

作者: wayne0303 時間: 2021-9-13 08:02

回復 32# samwang

感謝samwang大!
我再試看看~

作者: wayne0303 時間: 2021-9-13 08:26

回復 33# 准提部林

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

作者: wayne0303 時間: 2021-9-13 14:56

回復 33# 准提部林

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

謝謝~

作者: 准提部林 時間: 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

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

作者: wayne0303 時間: 2021-9-14 01:04

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

回復 37# 准提部林

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

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

作者: 准提部林 時間: 2021-9-14 10:35

回復 38# wayne0303

參考檔:
[attach]34021[/attach]

作者: wayne0303 時間: 2021-9-14 13:09

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

回復 39# 准提部林

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

作者: 准提部林 時間: 2021-9-14 16:55

回復 40# wayne0303

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

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

作者: wayne0303 時間: 2021-9-15 11:19

回復 41# 准提部林

回復 wayne0303

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

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

作者: Andy2483 時間: 2023-3-17 14:43

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

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

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

執行前:
[attach]35972[/attach]

執行結果:
[attach]35973[/attach]

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

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