- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-12-5
|
16#
發表於 2022-10-4 09:32
| 只看該作者
本帖最後由 Andy2483 於 2022-10-4 09:38 編輯
回復 14# jackyliu
學習心得如下供前輩參考
也請各位前輩指正!謝謝各位前輩!
Option Explicit
Sub 搜尋關鍵字() '→↑←↓
Application.ScreenUpdating = False
'↑執行時螢幕畫面不要跟著變動
Dim Arr, Brr, Crr, i, x, d, xD, T, q$, f$, n, xA, s, v, SD, SS&
'↑宣告變數
T = Timer
'↑令T=現在時間
Set xA = Sheets("關鍵字").Cells
'↑xA=關鍵字的所有儲存格
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD 是字典
SD = Array(, 1, 4, 7, 10, 13, 16) '@@
'↑令SD是一維陣列
For s = 1 To Columns.Count Step 2
'↑設定迴圈s從 1 到整個工作表的最後一欄,每繞回來一次s要+2
If xA(1, s) = "" Then
'↑當第1列的s欄是空格!
GoTo 101
'↑條件成立就跳到 101 的標示位置
End If
SS = (s + 1) / 2
'↑令SS 是要指向 SD陣列 的位置,當s是1時SS=1,是指向上方@@的1
'↑,當s是3時SS=3,是指向上方@@的4
Arr = Range(Cells(2, SD(SS)), Cells(Rows.Count, SD(SS)).End(3))
'↑把儲存格值倒入 Arr陣列 裡
'↑當s是1時,Arr陣列 裡放的是[A2:A101]
ReDim Crr(1 To UBound(Arr), 1 To 1)
'↑宣告 Crr陣列的大小!縱方向是1 到(Arr陣列縱向數量),橫方向是1欄)
Brr = xA.Range(xA(1, s), xA(Rows.Count, s + 1).End(3))
'↑把儲存格值倒入 Brr陣列 裡
'↑當s是1時,到進去的是Sheets("關鍵字").[A1:B10]
xD.RemoveAll
'↑清空xD字典
For d = 2 To UBound(Brr)
'↑設定迴圈,從2 到 Brr陣列縱向數量
xD(Brr(d, 1)) = Brr(d, 2)
'↑當d=2 字典的key="ABC",item="上上籤"
Next
For i = 1 To UBound(Arr)
'↑設定迴圈,從1 到 Arr陣列縱向數量
For Each x In xD.Keys
'↑令x是字典裡的一分子,迴圈從字典裡的第1個key開始運用
',每繞回來就變成第2個key.....
q = UCase(Arr(i, 1))
'↑令q字串是Arr陣列的值(且小寫英文字母都變大寫),例如 UCase("NHjoOa")="NHJOOA"
f = UCase(x)
'↑令f字串是xD.Key(且小寫英文字母都變大寫)
n = Len(x)
'↑令n是xD.Key的字數
If InStr(q, f) <> 0 Then
'↑如果q字串裡包含了f字串,f字串在q字串的第幾個字位置,例如 InStr("ABCD", "CD")=3
Crr(i, 1) = xD(x)
'↑如果上方條件成立!就令Crr陣列裝入 key是x 的item xD(x)
Cells(i + 1, SD(SS)).Characters(InStr(q, f), n).Font.ColorIndex = 3
'↑如果上方條件成立!就把字變紅色
Exit For
'↑如果上方條件成立!就跳出 (For Each x In xD.Keys)這個迴圈
End If
Next
Next
v = Array(, 2, 5, 8, 11, 14, 17)(SS)
'↑令v是一維陣列!是用來指定關鍵字所搜尋到的值要放哪裡
Cells(2, v).Resize(UBound(Crr), 1) = Crr
'↑當s=1時 把Crr倒入工作表[B2:B101]
Cells(1, v) = Brr(1, 2)
'↑當s=1時 [B1]="籤別"
Next
101
MsgBox "共耗時: " & Timer - T
Application.ScreenUpdating = True
'↑螢幕畫面恢復變動
End Sub |
|
