- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
34#
發表於 2023-3-31 16:18
| 只看該作者
本帖最後由 Andy2483 於 2023-3-31 16:23 編輯
回復 24# gctsai
謝謝論壇,謝謝前輩發表此主題與範例檔
後學藉此帖研究資料表排序後才帶入陣列,資料表復原,接著才進行統計,
學習到很多知識,學習方案如下,請各位前輩指教
來源表:
統計表:結果
Option Explicit
Sub 宣告()
Dim Brr, Crr, Y, N&, C&, R&, i&, j&, T$, T2$, T3$, TT$
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("來源"): Set Sh2 = Sheets("統計")
C = Sh1.UsedRange.Columns.Count: R = Sh1.UsedRange.Rows.Count
With Range(Sh1.[A1], Sh1.Cells(R, C + 1))
With .Columns(C + 1): .Value = "=ROW(A1)": .Value = .Value: End With
.Sort KEY1:=.Item(3), Order1:=1, Key2:=.Item(2), Order2:=1, Header:=1
Brr = .Value
.Sort KEY1:=.Item(C + 1), Order1:=1, Header:=1: .Columns(C + 1).Delete
End With
For i = 2 To UBound(Brr)
T = Brr(i, 3): If Y(T) = "" Then Y(T) = Y.Count: Y(T & "|儲位數") = ""
Next
Sh2.UsedRange.Delete
With Sh2.[A1].Resize(1, Y.Count)
.Value = Y.keys: .Replace "*|", "", Lookat:=xlPart
End With
ReDim Crr(1 To R, 1 To Y.Count)
For i = 2 To UBound(Brr)
T2 = Brr(i, 2): T3 = Brr(i, 3): TT = T3 & "|" & T2
If Y(TT) = "" Then
Y(T3 & "/r") = Y(T3 & "/r") + 1
Crr(Y(T3 & "/r"), Y(T3)) = T2
Crr(Y(T3 & "/r"), Y(T3) + 1) = 1
Y(TT) = 1
Else
N = Y(T3 & "/r")
Crr(N, Y(T3) + 1) = Crr(N, Y(T3) + 1) + 1
End If
Next
With Sh2.[A2].Resize(UBound(Crr), UBound(Crr, 2))
.Value = Crr: .EntireColumn.AutoFit
End With
Set Y = Nothing: Erase Brr, Crr: Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub |
|
D(Rng.Offset(, 1).Value) = D(Rng.Offset(, 1).Value) + 1
