asus103

回復 20# Hsieh
Hsieh大大：
感謝您
之前我誤以為d1(C) = ""中C是content
我想它應該是index吧？
如果是這樣，我應該看得懂了

假如我說的沒錯，您就不必浪費您寶貴的時間回覆
若我的想法有錯，在麻煩您告知

但願有一天我也能寫出這樣有創意的程式
無限的感激

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習的方案如下,請各位前輩指教
執行結果:

下載 (242.38 KB)

2024-3-6 15:41

Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, j%, C%, N&, X%, T$, 班級$
工作表2.UsedRange.ClearContents
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range(工作表1.[N1], 工作表1.[B65536].End(3)(1, 0))
ReDim Crr(UBound(Brr), 1 To 20)
For i = 1 To UBound(Brr)
   Z(Application.Text(i, "[DBNum1]")) = i
   If Brr(i, 2) = "學　號" Then
      班級 = Z(Mid(Brr(i - 2, 2), 2, 1)) & Mid(Brr(i - 2, 2), 4, 2)
      For j = 5 To UBound(Brr, 2)
         T = Brr(i, j): If T = "" Then C = j - 1: Exit For
         If Not Z.Exists(T) Then X = X + 1: Z(T) = X + 4: Crr(0, X + 4) = T
         Z(j) = Z(T)
      Next
   End If
   If Brr(i, 2) Like "######" Then
      N = N + 1: For j = 5 To 20: Crr(N, j) = -1: Next
      Crr(N, 1) = Brr(i, 2): Crr(N, 2) = Brr(i, 3): Crr(N, 3) = 班級: Crr(N, 4) = Brr(i, 4)
      For j = 5 To C: Crr(N, Z(j)) = Brr(i, j): Next
   End If
Next
With 工作表2.[A1].Resize(N + 1, X + 4): .NumberFormat = "@": .Value = Crr: End With
工作表2.[A1].Resize(, 4) = [{"學　號","姓名","班級","座號"}]
End Sub