- 帖子
- 406
- 主題
- 8
- 精華
- 0
- 積分
- 453
- 點名
- 0
- 作業系統
- WINDOWS 7
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2015-2-7
- 最後登錄
- 2021-7-31
|
本帖最後由 n7822123 於 2021-7-31 13:27 編輯
回復 15# 准提部林
同樣的概念改寫準大程式，但是速度比較慢 (不過還是比純跑迴圈快)
推測需要額外做字串串接、拆分 等運算，所以拖慢速度!
純粹用字典崁套，速度真的沒法比，真是厲害!
這概念還蠻容易理解的，像是先建立一個目錄，不用讓電腦每個去找
此做法，我第一個想到的是 ，可以應用在 多層下拉式選單
Sub TEST_AT()
Dim Arr, Brr, Crr(2), xD(2), T$, i&, j%, k, Km%, TM
TM = Timer
Crr(1) = Range([L!m1], [L!a1].Cells(Rows.Count, 1).End(xlUp))
Crr(2) = Range([R!m1], [R!a1].Cells(Rows.Count, 1).End(xlUp))
For j = 1 To 2
Set xD(j) = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Crr(j))
T = Left(Crr(j)(i, j + 9), 7)
xD(j)(T) = xD(j)(T) & " " & i
Next i
Next j
Arr = Range([序號!a1], [序號!a1].Cells(Rows.Count, 1).End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 2)
Brr(1, 1) = "工單號碼": Brr(1, 2) = "位置"
For i = 2 To UBound(Arr)
T$ = Left(Arr(i, 1), 7): Km = 0
For j = 1 To 2
For Each k In Split(Trim(xD(j)(T)))
k = Val(k)
If Crr(j)(k, 9 + j) <= Arr(i, 1) And Crr(j)(k, 11 + j) >= Arr(i, 1) Then
Brr(i, 1) = Crr(j)(k, j): Brr(i, 2) = Mid("LR", j, 1) & k
Km = 1: Exit For
End If
Next
If Km = 1 Then Exit For
j01: Next j
i01: Next i
[序號!b1].Resize(UBound(Brr), 2) = Brr
MsgBox Timer - TM
End Sub |
|
發表於 2021-7-30 01:47
| 
