'CurrentRegion 屬性 傳回 Range 物件，該物件代表目前的區域。目前區域是指以任意空白列及空白欄的組合為邊界的範圍。唯讀。
For Each E In .Rows
S = E.Cells(1, 2) & "-" & E.Cells(1, 3)
If D.Exists(S) Then '字典物件 的關鍵字存在
Ar = D(S)
ReDim Preserve Ar(1 To 3, 1 To UBound(Ar, 2) + 1)
'Preserve 選擇性引數。當改變原有陣列最後一維的大小時，仍然保有原來的資料的關鍵字。
For i = 1 To 3
Ar(i, UBound(Ar, 2)) = E.Cells(1, i)
Next
D(S) = Ar
DD(S) = Ar
Else
D(S) = Application.Transpose(E)
End If
Next
End With
For Each E In DD.ITEMS '字典物件的項目
With Range("F" & Rows.Count).End(xlUp).Offset(1)
Ar = Application.Transpose(E)
.Resize(UBound(Ar), 3) = Ar
End With
Next
End Sub
複製代碼
作者: Andy2483 時間: 2023-4-27 15:48
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行前:
[attach]36240[/attach]
執行結果:
[attach]36241[/attach]
Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 100, 1 To 3), A, Y, i&, j%, T1$, T2$, T3$, TT$, N%
Dim xR As Range, Ra As Range, Sh As Worksheet, xBook As Workbook
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([C1], Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Brr)
T1 = Brr(i, 1): T2 = Brr(i, 2): T3 = Brr(i, 3): TT = T2 & "/" & T3
A = Y(TT): N = Y(TT & "|R"): N = N + 1
If Not IsArray(A) Then A = Crr
For j = 1 To 3: A(N, j) = Brr(i, j): Next
Y(TT) = A: Y(TT & "|R") = N
Next
[K:M].ClearContents: [K1:M1] = [{"型號","座標X","座標Y"}]: N = 2
For Each A In Y.KEYS
If InStr(A, "|") Then GoTo i01
If Y(A & "|R") = 1 Then GoTo i01
Cells(N, "K").Resize(Y(A & "|R"), 3) = Y(A)
N = N + Y(A & "|R")
i01: Next
Set Y = Nothing: Erase Brr, Crr
End Sub
