- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
22#
發表於 2024-3-6 15:42
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習的方案如下,請各位前輩指教
執行結果:
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 |
|
