- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-3-24
|
本帖最後由 Andy2483 於 2023-6-17 10:12 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行結果:
Option Explicit
Sub TEST_1()
Dim Brr, i&, j%, y&, x%, V&, u%, R&, C%, A$
Brr = [A1].CurrentRegion: y = UBound(Brr): x = 12
For i = 1 To y
For j = 1 To x: A = A & "/" & Brr(i, j): Next
For j = 1 To 24
If InStr(A & "/", "/" & j & "/") = 0 Then
C = C + 1: Brr(i, C) = j
End If
Next
A = "": C = 0
Next
[O1].Resize(y, 12) = Brr
End Sub
Sub TEST_2()
Dim Brr, Crr, i&, j%, y&, x%, C%, Z
Set Z = CreateObject("Scripting.Dictionary")
Brr = [A1].CurrentRegion
ReDim Crr(1 To UBound(Brr), 1 To 24)
For i = 1 To UBound(Brr)
For j = 1 To 24
If j <= UBound(Brr, 2) Then Z(Brr(i, j)) = 1
If Z(j) = "" Then: C = C + 1: Crr(i, C) = j
Next
Z.RemoveAll: C = 0
Next
[O1].Resize(UBound(Brr), 12) = Crr
End Sub
Sub TEST_3()
Dim Brr, Crr, i&, j%, y&, x%, C%, Z, A%, B%, D%
Set Z = CreateObject("Scripting.Dictionary")
Brr = [A1].CurrentRegion: A = 1
ReDim Crr(1 To UBound(Brr), 1 To 24)
For i = 1 To UBound(Brr)
For j = 1 To 24
If j <= UBound(Brr, 2) Then Z(Brr(i, j)) = A
If Z(j) = B Then: C = C + 1: Crr(i, C) = j: Z(j) = A
Next
D = A: A = B: B = D: C = 0
Next
[O1].Resize(UBound(Brr), 12) = Crr
End Sub |
|
發表於 2023-6-17 09:51
| 