1

私が苦労してきた簡単な質問。文字列を含む長さの異なる 2 つの配列があります。重複が検出された場合に両方の要素を削除する新しい配列を出力したいと考えています。現時点では、重複を削除するだけですが、私が達成しようとしているものとは異なるオリジナルを残しています。

例えば

input = array ("cat","dog","mouse","cat")  
expected output =  array ("dog","mouse")  
actual output = array ("cat","dog","mouse")

コードは以下のとおりです。

Sub removeDuplicates(CombinedArray)
Dim myCol As Collection
Dim idx As Long
Set myCol = New Collection

On Error Resume Next

For idx = LBound(CombinedArray) To UBound(CombinedArray)
    myCol.Add 0, CStr(CombinedArray(idx))
    If Err Then
        CombinedArray(idx) = Empty
        dups = dups + 1
        Err.Clear
    ElseIf dups Then
        CombinedArray(idx - dups) = CombinedArray(idx)
        CombinedArray(idx) = Empty
    End If
Next

For idx = LBound(CombinedArray) To UBound(CombinedArray)
    Debug.Print CombinedArray(idx)
Next
removeBlanks (CombinedArray)
End Sub

事前にすべてのヘルプとサポートに感謝します。

4

2 に答える 2

2

を使用するのはScripting.Dictionaryどうですか？このような：

Function RemoveDuplicates(ia() As Variant)

Dim c As Object
Set c = CreateObject("Scripting.Dictionary")
Dim v As Variant
For Each v In ia
    If c.Exists(v) Then
        c(v) = c(v) + 1
    Else
        c.Add v, 1
    End If
Next

Dim out() As Variant
Dim nOut As Integer
nOut = 0

For Each v In ia
    If c(v) = 1 Then
        ReDim Preserve out(nOut) 'you will have to increment nOut first, if you have 1-based arrays
        out(nOut) = v
        nOut = nOut + 1
    End If
Next

RemoveDuplicates = out

End Function
于 2012-07-31T12:23:37.657 に答える
0

これが簡単な例です。エラーが発生した場合はお知らせください。

Sub Sample()
    Dim inputAr(5) As String, outputAr() As String, temp As String
    Dim n As Long, i As Long

    inputAr(0) = "cat": inputAr(1) = "Hen": inputAr(2) = "mouse"
    inputAr(3) = "cat": inputAr(4) = "dog": inputAr(5) = "Hen"

    BubbleSort inputAr

    For i = 1 To UBound(inputAr)
        If inputAr(i) = inputAr(i - 1) Or inputAr(i) = temp Then
            inputAr(i - 1) = "": temp = inputAr(i): inputAr(i) = ""
        End If
    Next i

    n = 0
    For i = 1 To UBound(inputAr)
        If inputAr(i) <> "" Then
            n = n + 1
            ReDim Preserve outputAr(n)
            outputAr(n) = inputAr(i)
        End If
    Next i

    For i = 1 To UBound(outputAr)
        Debug.Print outputAr(i)
    Next i
End Sub

Sub BubbleSort(arr)
    Dim value As Variant
    Dim i As Long, a As Long, b As Long, c As Long

    a = LBound(arr): b = UBound(arr)

    Do
        c = b - 1
        b = 0
        For i = a To c
            value = arr(i)
            If (value > arr(i + 1)) Xor False Then
                arr(i) = arr(i + 1)
                arr(i + 1) = value
                b = i
            End If
        Next
    Loop While b
End Sub

編集

ソートしない別の方法

Sub Sample()
    Dim inputAr(5) As String, outputAr() As String
    Dim n As Long, i As Long, j As Long
    Dim RemOrg As Boolean

    inputAr(0) = "cat": inputAr(1) = "Hen": inputAr(2) = "mouse"
    inputAr(3) = "cat": inputAr(4) = "dog": inputAr(5) = "Hen"

    For i = 0 To UBound(inputAr)
        For j = 1 To UBound(inputAr)
            If inputAr(i) = inputAr(j) Then
                If i <> j Then
                    inputAr(j) = "": RemOrg = True
                End If
            End If
        Next
        If RemOrg = True Then
            inputAr(i) = ""
            RemOrg = False
        End If
    Next i

    n = 0
    For i = 0 To UBound(inputAr)
        If inputAr(i) <> "" Then
            n = n + 1
            ReDim Preserve outputAr(n)
            outputAr(n) = inputAr(i)
        End If
    Next i

    For i = 1 To UBound(outputAr)
        Debug.Print outputAr(i)
    Next i
End Sub
于 2012-07-31T11:30:24.120 に答える