Scripting.Dictionary的應用 02

john2006168

老師,想問一下Scripting.Dictionary是否可以用在下列情況,請問要乖麼寫?
想要sheets("Summary")的結果-----sheets"PL"將數量除於箱數,其他資料不變,copy 到summary.

TEST2 (2).zip (13.93 KB)

下載次數: 10

2021-6-1 14:31

下載 (8.46 KB)

2021-6-1 14:23

下載 (11.16 KB)

2021-6-1 14:24

samwang

回復 1# john2006168

請測試看看，謝謝

Sub test()
Dim Arr, xD, T, T1, T2, T0%, i&, M%, N%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([PL!E1], [PL!A65536].End(3))
For i = 1 To UBound(Arr)
    T = Arr(i, 2): T1 = Arr(i, 3): T2 = Arr(i, 4)
    If xD.Exists(T & "") Then
        M = xD(T & "")
        If InStr(Arr(M, 5), "~") Then
            T0 = Split(Arr(M, 5), "~")(1)
        Else
            T0 = Arr(M, 5)
        End If
        If Arr(i, 5) = T0 + 1 Then
            Arr(M, 3) = Arr(M, 3) + T1
            Arr(M, 4) = Arr(M, 4) + T2
            Arr(M, 5) = Split(Arr(M, 5), "~")(0) & "~" & Arr(i, 5)
        Else
            GoTo 99
        End If
    Else
99:     N = N + 1: xD(T & "") = N
        For j = 1 To 5: Arr(N, j) = Arr(i, j): Next
    End If
Next
Sheets("Summary").[A1].Resize(N, 5) = Arr
End Sub

john2006168

回復 2# samwang

謝謝老師幫忙,另外想問一下,如果我summary有了資料,想要PL的結果,請問要怎麼寫

下載 (11.16 KB)

2021-6-2 14:55

.

samwang

回復 3# john2006168


不好意思，不太能理解你的需求，請再詳細說明一下，謝謝

john2006168

回復 4# samwang
不好意思,事件是sheet"Summary"現有資料,數量除於件數後,將它分開每一個項目到sheet "PL",(條件是數量除於件數)

samwang

回復 5# john2006168

請測試看看，謝謝。

Sub test2()
Dim Arr, Brr(1 To 10000, 1 To 5), T1, T2, T3, T4
Arr = Range([Summary!E1], [Summary!A65536].End(3))
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1): T2 = Arr(i, 2): T3 = Arr(i, 3): T4 = Arr(i, 4)
    For i2 = 1 To T4
        N = N + 1: Brr(N, 1) = T1: Brr(N, 2) = T2
        Brr(N, 3) = T3 / T4: Brr(N, 4) = 1: Brr(N, 5) = N
    Next
Next
Sheets("Summary").[A1:E1].Copy Sheets("PL").[A1]
Sheets("PL").[a2].Resize(N, 5) = Brr
End Sub

Andy2483

謝謝論壇,謝謝各位前輩

後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教

資料表:

下載 (31.7 KB)

2023-6-20 13:10

結果表執行前:

下載 (40.11 KB)

2023-6-20 13:10

執行結果:

下載 (64.73 KB)

2023-6-20 13:11

Option Explicit
Sub TEST_1()
Dim Brr, Crr, Z, A, i&, j%, R&, Y&, N&
Sheets("PL").UsedRange.ClearContents
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([Summary!E1], [Summary!A65536].End(3))
For i = 2 To UBound(Brr)
   A = Replace(Brr(i, 5), "~", "-"): A = A & "-" & A
   A = Split(A, "-")(0) & "-" & Split(A, "-")(1)
   R = Abs(Evaluate(A))
   For Y = 0 To R
      If Z(Val(A) + Y) <> "" Then
         MsgBox "箱號重複: " & Val(A) + Y & " 修正後再執行!"
         Exit Sub
      End If
      Z(Val(A) + Y) = i & "*0+" & Val(Brr(i, 3)) & "/" & (R + 1)
   Next
Next
ReDim Crr(1 To Z.Count + 1, 1 To 6)
For Each A In Z.keys
   If N = 0 Then
      N = 1: Crr(N, 6) = "Remark"
      For j = 1 To 5: Crr(N, j) = Brr(1, j): Next
   End If
   N = N + 1
   Crr(N, 1) = Brr(Val(Z(A)), 1)
   Crr(N, 2) = Brr(Val(Z(A)), 2)
   Crr(N, 3) = Evaluate(Z(A))
   Crr(N, 4) = 1
   Crr(N, 5) = A
   Crr(N, 6) = Brr(Val(Z(A)), 5)
Next
With [PL!A1].Resize(Z.Count + 1, 6)
   .Value = Crr
   .Sort KEY1:=.Item(5), Order1:=1, Header:=1
End With
Set Z = Nothing: Erase Brr, Crr
End Sub

mdr0465

回復 7# Andy2483


  Andy 師兄,您好

後學在程式中有一點不明白想向你請教,

A = Split(A, "-")(0) & "-" & Split(A, "-")(1)

在以上語句中的紅色字(0) / (1) 是代表什麼意思呢?在學習上應怎樣運用呢?

請指教,謝謝

Andy2483

回復 8# mdr0465


    謝謝 mdr0465回復,謝謝一起學習
後學盡可能表達所學的心得,心得如下:
   A = Split(A, "-")(0) & "-" & Split(A, "-")(1)
  '這裡的(0)是指A字串以"-"符號分割成為一維陣列索引號
   '以Split()分割字串後的一維陣列索引號從0開始
   'Split()(0),Split()(1),Split()(2)...依此類推
   '因為箱號 有單箱號(6,7),或區間箱號(2~5,9~10),所以用此法可一併處理
   '這方法是學習自 准提部林前輩指導的下列連結帖,請參考
   http://forum.twbts.com/viewthrea ... mp;page=1#pid121027

Sub TEST_2()
Dim A$, B$
A = "7"
B = "9-10"
B = B & "-" & B
MsgBox B
B = Split(B, "-")(0) & "-" & Split(B, "-")(1)
MsgBox B
MsgBox Abs(Evaluate(B))

A = A & "-" & A
MsgBox A
A = Split(A, "-")(0) & "-" & Split(A, "-")(1)
MsgBox A
MsgBox Abs(Evaluate(A))
End Sub

'==================================
補充:
如果將A,B變數設為通用型變數,就可以讓字串與一維陣列都可以被裝盛
Sub TEST_3()
Dim A, B
A = "7"
B = "9-10"
B = B & "-" & B
MsgBox B
B = Split(B, "-")
B = B(0) & "-" & B(1)
MsgBox B
MsgBox Abs(Evaluate(B))

A = A & "-" & A
MsgBox A
A = Split(A, "-")
A = A(0) & "-" & A(1)
MsgBox A
MsgBox Abs(Evaluate(A))
End Sub

至於怎麼運用? 建議多練習各種範例情境
建議前輩多上論壇發表看法.心得...做交流,達到 高中生等級,可搜尋內文,有超多的範例知識可學習與練習

下載 (147.64 KB)

2023-7-6 14:06

mdr0465

回復 9# Andy2483


Andy 師兄,
謝謝你詳細的解答, 我會多上論壇多學習,

萬分感謝你