- 帖子
- 1567
- 主題
- 40
- 精華
- 0
- 積分
- 1591
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2026-2-2
|
本帖最後由 Andy2483 於 2023-5-12 14:20 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行前:
執行結果:
Option Explicit
Sub TEST()
Dim Brr, Crr, Y, N&, i&, j&
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Brr = Range([C1], Cells(Rows.Count, 1).End(3))
'↑令Brr變數是 二維陣列,以A~C欄儲存格資料帶入陣列裡
ReDim Crr(1 To UBound(Brr), 1 To 3)
'↑宣告Crr是二維空陣列,縱向範圍同Brr陣列,橫向從1~3
For i = 1 To UBound(Brr)
'↑設順迴圈
If i = 1 Then N = 1: For j = 1 To 3: Crr(N, j) = Brr(i, j): Next
'↑處理標題列
If Brr(i, 1) = "一級文員" And InStr("/中文課程/英文課程/", "/" & Brr(i, 3) & "/") Then
'↑如果符合條件
If Y(Brr(i, 2) & "") = "" Then
'↑如果姓名不重複
N = N + 1
For j = 1 To 3: Crr(N, j) = Brr(i, j): Next
'↑符合條件又不重複的資料寫入Crr陣列裡
Y(Brr(i, 2) & "") = 1
'↑令此字典裡此key的item值是 1(讓後迴圈濾重複)
End If
End If
Next
[E12].Resize(N, 3) = Crr
'↑令Crr陣列值從[E12]寫入儲存格裡
Set Y = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub |
|