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作者: n7822123 時間: 2021-7-31 13:24
這樣又讓我想起一條新出路
如果沒錯 資料量在更加龐大的情況 甚至字典 跟 陣列 做排序資料 還可以交互運用找到平衡點
字典嵌字典這招真的非常強大 應該可以玩很久!
想來測試一下 陣列裡面可以不可以嵌字典 如果可以的話 可玩性又高出許多
(看來是可以的,不過前面要加上set )
Sub ttt()
Dim ar
ReDim ar(5)
Set xD = CreateObject("Scripting.Dictionary")
Set ar(1) = xD
ar(2) = 123
End Sub
Sub tttt()
t = Timer
Dim L As Worksheet
Dim R As Worksheet
Dim S As Worksheet
Dim i%, j%, w%, rw%, a%
Dim x As String
Dim TX As String
Set L = Sheets("L")
Set R = Sheets("R")
Set S = Sheets("OP")
f = S.Columns("A").Find("*", , -4163, , 1, 2).Row
f0 = L.Columns("A").Find("*", , -4163, , 1, 2).Row
f1 = R.Columns("A").Find("*", , -4163, , 1, 2).Row
ss = S.Range("A2").Resize(f, 1)
SL = L.Range("A2").Resize(f0, 12)
SR = R.Range("B2").Resize(f1, 12)
...
Sub LR全部比對()
Dim LR(1 To 2), SN
TM = Timer
Set SN = Sheets("序號")
LR(1) = [L!A1:L1].Resize([L!J65536].End(xlUp).Row)
LR(2) = [R!B1:M1].Resize([R!J65536].End(xlUp).Row)
Arr = SN.[A1].Resize(SN.[A65536].End(xlUp).Row, 3)
ReDim Brr(1 To UBound(Arr), 1 To 4)
Brr(1, 1) = "工單號碼": Brr(1, 2) = "LR位置": Brr(1, 3) = "起始BarCode": Brr(1, 4) = "結束BarCode"
For i = 2 To UBound(Arr)
Key = "": Wno = ""
For j = 1 To 2
For k = 2 To UBound(LR(j))
If LR(j)(k, 10) <= Arr(i, 1) And Arr(i, 1) <= LR(j)(k, 12) Then
'Brr(i, 1) = LR(j)(k, 1)
'Brr(i, 2) = LR(j)(k, 3) & k
'Km = 1: Exit For
Brr(i, 1) = Brr(i, 1) & "," & LR(j)(k, 1) 'L R 工單號碼
Brr(i, 2) = Brr(i, 2) & "," & LR(j)(k, 3) & k 'L R 位置
Brr(i, 3) = Brr(i, 3) & "," & LR(j)(k, 10) & k 'L R 起始Barcode
Brr(i, 4) = Brr(i, 4) & "," & LR(j)(k, 12) & k 'L R 結束Barcode
End If
Next
'If Km = 1 Then Km = 0: Exit For
Next
Next
SN.[D1].Resize(UBound(Arr), 4) = Brr
SN.Range("D2,E3,F2,G2").Columns.AutoFit
Debug.Print Timer - TM
End Sub作者: singo1232001 時間: 2021-8-3 21:03
請教前輩 範例中的判斷式 以字串比大小! 是以什麼規則比大小或等於?
If Crr(j)(k, 9 + j) <= Arr(i, 1) And Crr(j)(k, 11 + j) >= Arr(i, 1) Then
自己有測試,但是無法了解規則!顛覆後學的認知! 以為只有數字才能比較!
Sub TEST_20220719()
If [A2] > [A3] Then
MsgBox "[A2] > [A3]"
Else
MsgBox "[A2] <= [A3]"
End If
End Sub
您的範例完整內容如下:
Sub TEST_A2()
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)
If Not IsObject(xD(j)(T)) Then
Set xD(j)(T) = CreateObject("Scripting.Dictionary")
End If
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
If Not IsObject(xD(j)(T)) Then
GoTo 666
End If
For Each k In xD(j)(T).keys
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
End If
666
Next j
Next i
[序號!b1].Resize(UBound(Brr), 2) = Brr
MsgBox Timer - TM
End Sub
