- 帖子
- 1567
- 主題
- 40
- 精華
- 0
- 積分
- 1591
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2026-2-2
|
本帖最後由 Andy2483 於 2023-12-4 16:28 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列.字典與橫向縱向排序...,學習方案如下,請各位前輩指教
資料表:
結果表執行前:
執行後的結果表:
Option Explicit
Sub TEST_A()
Dim Brr, Crr(2000, 100), v, Z, Q, i&, j%, R&, C%, N&, U%, T2$, T8$
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range(Sheet2.[H1], Sheet2.[B65536].End(3)(1, 0))
For i = 5 To UBound(Brr)
T2 = Trim(Brr(i, 2)): T8 = Trim(Brr(i, 8))
If T2 = "" Or T8 = "" Then GoTo i01
R = Z(T2): C = Z(T8): Crr(0, 0) = "日期"
If R = 0 Then N = N + 1: R = N: Z(T2) = R: Crr(R, 0) = T2
If C = 0 Then U = U + 1: C = U: Z(T8) = C: Crr(0, C) = T8
Crr(R, C) = Crr(R, C) + 1
i01: Next
Sheet1.[B6:B2000].EntireRow.Delete
With Sheet1.[B6].Resize(N + 1, U + 2)
.Value = Crr
.Offset(0, 1).Sort KEY1:=.Item(1, 2), Order1:=1, Header:=0, Orientation:=2
.Offset(1, 0).Sort KEY1:=.Item(2, 1), Order1:=1, Header:=0, Orientation:=1
.Item(1)(2, U + 2).Resize(N, 1) = "=SUM(" & Range(.Cells(2, 2), .Cells(2, U + 1)).Address(0, 0) & ")"
.Cells(1, U + 2) = "Total"
.Borders.LineStyle = 1
End With
End Sub |
|
發表於 2023-12-4 15:55
| 