找出特定範圍內未列出的數字

f00l01

大家好，小弟再次來向麻辣家族的大大拜問

樣本內的每一列數字，都是從1到24的數字內的隨機選出12個不重複數字

請問該如何篩選出每一列未獲選的數字？

懇請麻辣家族的大神們得空出手解答。再次先謝謝大家幫忙。

samwang

回復 1# f00l01

請測試看看，謝謝。

Sub test()
Dim Arr, xD, i&, j&, x%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([A1], [L65536].End(3))
For i = 1 To UBound(Arr)
    For x = 1 To 24: xD(x & "") = "": Next
    For j = 1 To UBound(Arr, 2)
        xD.Remove (Arr(i, j) & "")
    Next
    Cells(i, 15).Resize(1, xD.Count) = xD.keys
    xD.RemoveAll
Next
End Sub

f00l01

收到，我試試看，謝謝

f00l01

回復 2# samwang


   看起來數字都有出現，而且沒有需要偵錯的地方

感謝大大幫忙！~

samwang

回復 4# f00l01


結果顯示在同一格，請測試看看，謝謝。
Sub test2()
Dim Arr, xD, i&, j&, x%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([A1], [L65536].End(3))
For i = 1 To UBound(Arr)
    For x = 1 To 24: xD(x & "") = "": Next
    For j = 1 To UBound(Arr, 2)
        xD.Remove (Arr(i, j) & "")
    Next
    Arr(i, 1) = Join(xD.keys, ",")
    xD.RemoveAll
Next
Range("n1").Resize(UBound(Arr)) = Arr
End Sub

f00l01

回復 5# samwang


    都有顯示在同一格，再次感謝

hcm19522

https://blog.xuite.net/hcm19522/twblog/589734457

Andy2483

謝謝論壇,謝謝各位前輩

後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教

執行結果:

下載 (78.16 KB)

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

Andy2483

回復 8# Andy2483



謝謝論壇,謝謝各位前輩
後學藉此帖練習減少變數的使用,請各位前輩指教

Sub TEST_4()
Dim Brr, i&, j%, C%, Z
Set Z = CreateObject("Scripting.Dictionary")
Brr = [A1].CurrentRegion
For i = 1 To UBound(Brr)
   For j = 1 To 24
      If j <= UBound(Brr, 2) Then Z(Brr(i, j)) = i
      If Z(j) <> i Then: C = C + 1: Brr(i, C) = j
   Next
   C = 0
Next
[O1].Resize(UBound(Brr), 12) = Brr
End Sub

hcm19522

(輸入編號11987) google網址:https://hcm19522.blogspot.com/