Andy2483

謝謝論壇,謝謝各位前輩
後學今天練習陣列與字典,將陣列一次寫入儲存格,練習方案如下,請各位前輩指教

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