- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
回復 1# m06o2
謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考
 測試_20230921_1.zip (64.17 KB)
資料表:
結果表:
Option Explicit
Sub TEST()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Arr(1 To 16, 1 To 12), Brr, Crr, V, D, E, Z, Q, i&, j%, R&
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([總表!A4], [總表!O65536].End(3))
For i = 1 To UBound(Brr)
If Trim(Brr(i, 7)) <> "" And Brr(i, 15) = "" Then MsgBox "資料不完整": Exit Sub
If Val(Brr(i, 15)) > 0 Then
For j = 1 To 9
If Trim(Brr(i, j)) = "" Then MsgBox "資料不完整": Exit Sub
Next
End If
Next
D = Array(1, 2, 3, 7, 11, 12)
E = Split("2,4,6,8,9,15", ",")
For i = 1 To UBound(Brr)
V = Z(Brr(i, 7))
If Not IsArray(V) Then V = Arr
R = Z(Brr(i, 7) & "|R") + 1: Z(Brr(i, 7) & "|R") = R
For j = 0 To UBound(D): V(R, D(j)) = Brr(i, E(j)): Next
Z(Brr(i, 7)) = V
Next
Crr = Range([輔助表!C1], [輔助表!A65536].End(3))
For i = 1 To UBound(Crr): Z(Crr(i, 1) & "|") = i: Next
For i = Sheets.Count To 1 Step -1
If InStr(Sheets(i).Name, ".") Then Sheets(i).Delete
Next
For Each Q In Z.KEYS
If Not IsArray(Z(Q)) Then GoTo Q01
With Sheets("列印").Copy(after:=Worksheets(Sheets.Count))
R = Z(Q & "|R"): ActiveSheet.Name = Q & "."
[B3] = Q: [B4] = Crr(Z(Q & "|"), 2): [B5] = Crr(Z(Q & "|"), 3)
With [A9].Resize(R, 12)
.Value = Z(Q): .Borders.LineStyle = 1
.Item(.Count + 11) = "總計:": .Item(.Count + 11).Font.Bold = True
.Item(.Count + 12) = "=SUM(L9:L" & 8 + R & ")"
.Item(.Count + 12).Font.Bold = True
With Range(.Item(.Count + 25), [L27])
.Merge: .Value = "備註:"
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Borders.LineStyle = 1
End With
End With
End With
Q01: Next
Set Z = Nothing: Erase Arr, Brr, Crr
End Sub |
|
發表於 2023-9-21 08:50
| 
