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 時間: 2021-6-2 14:55
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 時間: 2023-6-20 13:11
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
資料表:
[attach]36627[/attach]
結果表執行前:
[attach]36628[/attach]
執行結果:
[attach]36629[/attach]
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 時間: 2023-7-6 12:56
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
