請益是否有更快的查詢方式 - Excel程式區

singo1232001

　暱稱: 熱狗慶

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

21^# 跳轉到 »

發表於 2021-8-2 08:56 | 只看該作者

本帖最後由 singo1232001 於 2021-8-2 09:01 編輯

回復 19# 准提部林

保持實驗學習精神
跟准大學到好多字典寶貴的技巧

最後回頭繼續測試
原來先轉陣列還可以在加速

目前也把時間壓縮成功!
順便奉上檔案參考

另外也測試了陣列與字典的適用區間真的好好玩!

3維陣列工單查詢 v4 v1.zip (971.39 KB)

陣列與字典測速1.zip (17.35 KB)

TOP

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

22^#

發表於 2021-8-2 23:50 | 只看該作者

我測試了一下，大部分L跟R都有符合的BarCode啟始及結束條件的工單號碼，
所以L先找或R先找會有不同的答案?

例如
BarCode 符合位置
A2 CYR128401TG0WLX2H R42,L38
A3 CYR128401600WLX2U R42,L3,L38

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

singo1232001

　暱稱: 熱狗慶

中學生 Rank: 2

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

23^#

發表於 2021-8-3 18:14 | 只看該作者

本帖最後由 singo1232001 於 2021-8-3 18:17 編輯

回復 22# ML089

如果是指我的這份檔案的話 "3維陣列工單查詢 v4 v1"
執行後的結果有異常有漏缺資料
是我的vba裡面有bug

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)
...

紅色的地方我打錯了應該是R
狀況是會有許多資料沒抓到
昨天晚上才發現的
附上修改好的檔案

3維陣列工單查詢 v4 v2.zip (975.69 KB)

TOP

fantersy

中學生 Rank: 2

帖子: 132
主題: 35
精華: 0
積分: 179
點名: 0
作業系統: Windows
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2014-12-24
最後登錄: 2024-8-2

24^#

發表於 2021-8-3 20:02 | 只看該作者

字典這一塊我真的很不熟
最近才開始接觸
准大真的太強了!!每次發問都學到不少
感謝幫忙

TOP

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

25^#

發表於 2021-8-3 20:22 | 只看該作者

回復 23# singo1232001

誤會了! 不是說你程式的問題

我作全比對L R兩個資料表，大部分這兩組資料表裡都有符合的位置，
因為大家的程式都是先比查詢L表在查詢R表，
我在練習時將查詢順序改為先比查詢R表在查詢L表，答案跟大家不同
所以發現資料去比對起始BarCode 跟結束BarCode，在L R表都有答案，滿奇怪的。

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

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

singo1232001

　暱稱: 熱狗慶

中學生 Rank: 2

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

26^#

發表於 2021-8-3 21:03 | 只看該作者

回復 25# ML089

確實跟你講的一樣有重複

3維陣列工單查詢 v4 v3.zip (824.46 KB)

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-11-29

27^#

發表於 2022-7-19 15:19 | 只看該作者

回復 12# 准提部林

請教前輩範例中的判斷式以字串比大小! 是以什麼規則比大小或等於?
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

謝謝前輩指導!

TOP

Andy2483