- 帖子
- 1567
- 主題
- 40
- 精華
- 0
- 積分
- 1591
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2026-2-2
|
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行結果:
Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 1000, 1 To 5), T(2 To 4), Z, P, A, Q&, i&, R&, N&, F&, j%, x%, B$, T0$, T1$
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([E2], [A65536].End(xlUp))
P = [{"出貨人","品名","件數","件重/ kg","總重量"}]
For i = 1 To UBound(Brr)
If Z(Brr(i, 1) & "") = "" Then F = F + 1: Z(Brr(i, 1) & "") = F + 1: Z(F + 1) = Brr(i, 1)
B = IIf(Brr(i, 4) >= 10, Brr(i, 1) & "/重計", Brr(i, 1) & "/件計")
Q = Z(B & Brr(i, 2) & "/" & Brr(i, 4))
A = Z(B): R = Z(B & "\r")
If Not IsArray(A) Then A = Crr: R = R + 1: For j = 1 To 5: A(R, j) = P(j): Next
If Q = 0 Then
R = R + 1: A(R, 1) = Brr(i, 1): A(R, 2) = Brr(i, 2): A(R, 4) = Brr(i, 4)
Q = R: Z(B & Brr(i, 2) & "/" & Brr(i, 4)) = Q
End If
A(Q, 3) = A(Q, 3) + Val(Brr(i, 3))
Z(B) = A: Z(B & "\r") = R
Next
[N:R].Clear: N = F + 2
With [N1].Resize(F + 1, 4)
.Rows(1) = [{"出貨人","總件數","總重量","合計運費"}]
.Borders.LineStyle = xlContinuous
.Font.Bold = True
.Font.ColorIndex = 5
For i = 2 To F + 1: [N1].Item(i, 1) = Z(i): Next
End With
For Each A In Z.Keys
If Not IsArray(Z(A)) Then GoTo A01 Else R = Z(A & "\r")
T0 = Split(A, "/")(0): T1 = Split(A, "/")(1)
With [N1].Item(N + 1).Resize(Z(A & "\r") + 1, 5)
.Value = Z(A): .Cells(R + 1, 1) = "運費合計"
.Cells(2, 5).Resize(R - 1) = "=" & .Cells(2, 3).Address(0, 0) & "*" & .Cells(2, 4).Address(0, 0)
T(2) = "=SUM(P" & N + 2 & ":P" & N + R & ")"
T(3) = "=SUM(R" & N + 2 & ":R" & N + R & ")"
If T1 = "件計" Then
.Cells(R + 1, 4) = "以件計"
.Cells(R + 1, 3) = T(2)
T(4) = "=" & .Cells(R + 1, 3).Address(0, 0) & "*15"
.Cells(R + 1, 2) = Evaluate(T(4))
Else
.Cells(R + 1, 4) = "以重計"
.Cells(R + 1, 5) = T(3)
T(4) = "=" & .Cells(R + 1, 5).Address(0, 0) & "*2"
.Cells(R + 1, 2) = Evaluate(T(4))
End If
.Cells(R + 1, 1).Resize(, 2).Font.Bold = True
.Cells(R + 1, 1).Resize(, 5).Font.ColorIndex = 5
.Cells.Borders.LineStyle = xlContinuous
.Cells.Interior.ColorIndex = 24 + (T1 = "件計") * 4
End With
For j = 2 To 4: [N1].Item(Z(T0), j) = [N1].Item(Z(T0), j) + Evaluate(T(j)): Next
N = N + R + 1
A01: Next
End Sub |
|
發表於 2023-11-29 14:28
| 