Suchen Sie sich wiederholende Zahlen im Array VBA

Question

Ich versuche, ein Array der Größe 50 in VBA von Zufallszahlen zwischen 0 und 20 zu erstellen und dann die Zahlen, die in diesem Array wiederholen, in ein anderes Array zu extrahieren.

Sub Problem10() 
Dim numbers() As Double, odd() As Double, even() As Double, five() As Double, repeating() As Double, x As Integer, i As Integer, sOdd As Integer, sEven As Integer, sFive As Integer, sNumbers As Integer, sRepeating As Integer, y As Integer, listed As Boolean 
sRepeating = 0 
sNumbers = 50 
For i = 1 To sNumbers 
    ReDim Preserve numbers(i) 
    numbers(i) = Int(20 * rnd) 
    'find repeating numbers 
    For x = 1 To i 
     If numbers(x) = numbers(i) And i <> x Then 
      'check if there are any repeated numbers already 
      If sRepeating > 0 And listed = False Then 
       For y = 1 To sRepeating 
        'check if the number is already listed as a repeated number 
        If numbers(i) = repeating(y) Then 
         listed = True 
        Else 
         sRepeating = sRepeating + 1 
         ReDim Preserve repeating(sRepeating) 
          repeating(sRepeating) = numbers(i) 
          Cells(sRepeating + 1, 4).Value = repeating(sRepeating) 
          listed = True 
        End If 
       Next y 
      End If 
     End If 
    Next x 
    Cells(i + 1, 5).Value = numbers(i) 
Next i 
End Sub 

Ich bin in der Lage das Array mit Zufallszahlen (Zahlen()) und dann neue Arrays mit gerade, ungerade Zahlen und Multiples von 5. Allerdings extrahieren zu schaffen, ich weiß nicht, wie nur sich wiederholende Zahlen zu extrahieren. Im Moment findet dies nur die erste Wiederholungszahl und sonst nichts.

Answer 1

Betrachten Sie das folgende Beispiel:

Option Explicit 

Sub Test() 

    Dim i 
    Dim numbers(0 To 49) 
    Dim repeating() 
    Dim q 

    ' Fill array with random numers 
    Randomize 
    For i = 0 To 49 
     numbers(i) = Int(20 * Rnd) 
    Next 

    ' Filter repeating elements 
    With CreateObject("Scripting.Dictionary") 
     ' Count each number qty 
     For i = 0 To 49 
      .Item(numbers(i)) = .Item(numbers(i)) + 1 
     Next 
     ' Remove non-repeating 
     For Each q In .Keys() 
      If .Item(q) = 1 Then .Remove q 
     Next 
     ' Retrieve array 
     repeating = .Keys() 
    End With 

    Debug.Print Join(numbers) 
    Debug.Print Join(repeating) 

End Sub