在数组vba中查找重复数字

时间:2017-03-01 20:03:37

标签: arrays excel vba integer repeat

我正在尝试在0到20之间的随机数的vba中创建一个大小为50的数组,然后将在该数组中重复的数字提取到另一个数组中。

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

我能够用随机数(数字())创建数组,然后提取偶数,奇数和5的倍数的新数组。但是,我不知道如何只提取重复数字。 现在,这只能找到第一个重复的数字,而不是其他任何内容。

1 个答案:

答案 0 :(得分:1)

考虑以下示例:

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