- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-11-29
|
5#
發表於 2022-10-25 10:19
| 只看該作者
回復 2# singo1232001
謝謝前輩指導
前輩厲害!
之前有瀏覽這主題:
http://forum.twbts.com/viewthrea ... a=pageD3&page=3
當時都還看不懂,謝謝前輩在此帖指導!
執行時間超短!
以下學習到的心得註解一下! 如有冒犯請見諒!
請前輩指正並再指導! 謝謝
Option Explicit
Sub 執行這個()
Dim T
'↑宣告變數
T = Timer
'↑令T是當下時間 @2
Sheets("工作表_1").Range("F:k").ClearContents
'↑清除表_1 "F:k"欄位儲存格內容
Call test
'↑執行副程式 test()
Call test2
'↑執行副程式 test2()
MsgBox Timer - T & " 秒"
'↑跳出提示窗!顯示 最後時間 - 剛剛的 當下時間 @2
End Sub
Sub test()
Dim v As String, ve As String, sr, d, S, r, i, h, rr
'↑宣告變數
sr = Split("工作表_3,工作表_4,工作表_7", ",") '@1
'↑令 sr是一維陣列!3個將被搜尋的資料表名稱以","符號分個割 倒入sr
'這是要被 工作表_1(以下稱表_1) A欄搜尋取對應值的3個工作表!
Set d = CreateObject("scripting.dictionary")
'↑令d是字典
Set S = Sheets("工作表_1")
'↑令s 是物件 "表_1" 工作表
r = S.Cells(Rows.Count, 1).End(3).Row
'↑令r是表_1 A欄有內容的儲存格最後一列數
For i = 1 To r
'↑設順迴圈從1 到 A欄有內容的儲存格最後一列數
v = S.Cells(i, 1).Value
'↑令v是 表_1 的迴圈A欄儲存格值
ve = Left(v, 1)
'↑令ve 是 A欄儲存格值的最左邊的字元
If d.exists(ve) = False Then
'↑如果d字典裡沒有這個字元的key
Set d(ve) = CreateObject("scripting.dictionary")
'↑若條件成立!就將此字元為key,item是一個d字典中的字典
End If
d(ve)(v) = S.Cells(i, 1).Row
'↑令 d字典中的字典 d(ve)倒入 A欄儲存格值為key!儲存格列位為item
Next
ReDim ar(1 To r, 0 To 2) As String
'↑宣告字串ar 陣列的縱向範圍是1 到 表_1 A欄有內容的儲存格最後一列數
'橫向範圍是0 到2
For h = 0 To 2
'↑設外順迴圈從0 到2
Set S = Sheets(sr(h))
'↑令s是 被搜尋的資料表 @1
rr = S.Cells(Rows.Count, 1).End(3).Row
'↑令rr是 被搜尋表 A欄有內容的儲存格最後一列數
For i = 1 To rr
'↑設內順迴圈從1 到被搜表 A欄有內容的儲存格最後一列數
ve = S.Cells(i, 1).Value
'↑令ve是被搜表 的迴圈A欄儲存格值(關鍵字)
ar(d(Left(ve, 1))(ve), h) = S.Cells(i, 3).Value
'↑以 被搜表關鍵字最左邊字元為key 查察d字典中對應的item字典
',這以字首為名(key)的字典中字典,以被搜表關鍵字查察對應的列數(表_1),
'為ar陣列的列位,h是該關鍵字搜尋到值的指定欄位
'↑也就是把 被搜表關鍵字搜尋到的值 放到字典記錄的ar陣列列位中
Next
Next
Sheets("工作表_1").Cells(1, 6).Resize(r, 3) = ar
'↑將 ar陣列的值從表_1的[F1]開始貼入
End Sub
Sub test2()
Dim v As String, ve As String, sr, d, S, r, i, h, rr
'↑宣告變數
sr = Split("工作表_2,工作表_5,工作表_6", ",")
'↑令 sr是一維陣列!3個將被搜尋的資料表名稱以","符號分個割 倒入sr
'這是要被 工作表_1(以下稱表_1) D欄搜尋取對應值的3個工作表!
Set d = CreateObject("scripting.dictionary")
'↑令d是字典
Set S = Sheets("工作表_1")
'↑令s 是物件 表_1 工作表
r = S.Cells(Rows.Count, 4).End(3).Row
'↑令r是表_1 D欄有內容的儲存格最後一列數
For i = 1 To r
'↑設順迴圈從1 到 D欄有內容的儲存格最後一列數
v = S.Cells(i, 4).Value
'↑令v是 表_1 的迴圈D欄儲存格值
ve = Left(v, 1)
'↑令ve 是 D欄儲存格值的最左邊的字元
If d.exists(ve) = False Then
'↑如果d字典裡沒有這個字元的key
Set d(ve) = CreateObject("scripting.dictionary")
'↑若條件成立!就將此字元為key,item是一個d字典中的字典
End If
d(ve)(v) = S.Cells(i, 4).Row
'↑令 d字典中的字典 d(ve)倒入 D欄儲存格值為key!儲存格列位為item
Next
ReDim ar(1 To r, 0 To 2) As String
'↑宣告字串ar 陣列的縱向範圍是1 到 表_1 D欄有內容的儲存格最後一列數
'橫向範圍是0 到2
For h = 0 To 2
'↑設外順迴圈從0 到2
Set S = Sheets(sr(h))
'↑令s是 被搜尋的資料表 @1
rr = S.Cells(Rows.Count, 1).End(3).Row
'↑令rr是 被搜尋表 A欄有內容的儲存格最後一列數
For i = 1 To rr
'↑設內順迴圈從1 到被搜表 A欄有內容的儲存格最後一列數
ve = S.Cells(i, 1).Value
'↑令ve是被搜表 的迴圈A欄儲存格值(關鍵字)
ar(d(Left(ve, 1))(ve), h) = S.Cells(i, 3).Value
'↑以 被搜表關鍵字最左邊字元為key 查察d字典中對應的item字典
',這以字首為名(key)的字典中字典,以被搜表關鍵字查察對應的列數(表_1),
'為ar陣列的列位,h是該關鍵字搜尋到值的指定欄位
'↑也就是把 被搜表關鍵字搜尋到的值 放到字典記錄的ar陣列列位中
Next
Next
Sheets("工作表_1").Cells(1, 9).Resize(r, 3) = ar
'↑將 ar陣列的值從表_1的[I1]開始貼入
End Sub |
|
發表於 2022-10-28 15:00
| 
