- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
謝謝論壇,謝謝各位前輩
後學今天練習陣列與字典,將陣列一次寫入儲存格,練習方案如下,請各位前輩指教
Option Explicit
Sub TEST_1()
Dim Brr, Crr, V, Y, R&, C%, i&, T$, xR As Range, Ma%
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([B2], Cells(Rows.Count, "A").End(3)): Brr = xR
ReDim Crr(1 To UBound(Brr), 1 To Columns.Count - 14)
For i = 1 To UBound(Brr)
T = Brr(i, 2)
If Y(T & "/R") = "" Then
R = R + 1: Y(T & "/C") = 1
Y(T & "/R") = R: Crr(R, 1) = Brr(i, 2)
Else
Y(T & "/C") = Y(T & "/C") + 1
Crr(Y(T & "/R"), Y(T & "/C")) = Brr(i, 1)
End If
If Y(T & "/C") > Ma Then Ma = Y(T & "/C")
Next
[N1].Resize(, Ma).EntireColumn.Clear
[N7].Resize(R, Ma) = Crr: [N6] = [B1]
[N7].CurrentRegion.Borders.LineStyle = 1
Set Y = Nothing: Set xR = Nothing: Erase Brr, Crr
End Sub |
|
發表於 2023-4-7 09:52
| 