[VBA] unieke records in array

[Verwijderd]

Hoi,

Final topic. Ik heb een gesorteerde array die er zo uitziet:

1
2
4
7
7
7
777777777

Ik ga vervolgens deze array filteren met de volgende methode:

code:

Private Sub UniqueItems(ArrayIn, Optional Count As Variant)
     
    Dim Unique() As Long
    Dim Element As Variant
    Dim i As Integer
    Dim FoundMatch As Boolean
     
     
    If IsMissing(Count) Then Count = True
     
    NumUnique = 0
     
    For Each Element In ArrayIn
        FoundMatch = False
         
    
        For i = 1 To NumUnique
            If Element = Unique(i) Then
                FoundMatch = True
                GoTo AddItem
            End If
        Next i

AddItem:
        If Not FoundMatch Then
            NumUnique = NumUnique + 1
            ReDim Preserve Unique(NumUnique)
            
            Unique(NumUnique) = Element
            
        End If
         
    Next Element

    Call PrintArray(Unique())

End Sub

Het resultaat is:

0
1
2
4
7
777777777


Bijna goed alleen die 0 moet er uit en weet niet hoe ik dat kan fiksen. Volgens mij zit het hem bij AddItem omdat ie daar de de array size aanpast naar 1 voordat er een waarde is ingevuld. De Unique(0) = dan volgens mij leeg of 0. Kan iemand mij helpen?? Veel dank.

Groet

[djexplo]

vervang "NumUnique = 0" door "NumUnique = -1" dan levert de eerste keer "NumUnique = NumUnique + 1" nul op....

[ Voor 77% gewijzigd door djexplo op 20-04-2007 13:51 ]

[onkl]

djexplo schreef op vrijdag 20 april 2007 @ 13:51:
vervang "NumUnique = 0" door "NumUnique = -1" dan levert de eerste keer "NumUnique = NumUnique + 1" nul op....

Denk er dan wel om de regel

Visual Basic:

For i = 1 To NumUnique

te vervangen door

Visual Basic:

For i = 1 To Ubound(Unique)

De eerste waarde van een standaard array is 0 (dat kan je veranderen door bovenaan je code option base = 1 te zetten of, alleen voor deze array, door Unique te dimensioneren als Dim Unique (1 to 1) as Long en zo ook te Redimmen.)

BTW, post bij opgeloste topics/problemen even hoe je iets werkend hebt gekregen: toekomstige gebruikers van de search zijn je nu al dankbaar.

[Verwijderd]

Hoi

onkl:

Jouw eertse comment werkt niet: krijg een error out of range. Van optie 2 weet ik niet hoe je die moet definieren? Kan je dat toelichten, alvast dank.

djexplo:

Werkt zolang de laagste waarde van je array maar 1 keer voorkomt. Indien deze twee keer voorkomt krijg je hem twee keer gedisplayed. Wanneer ie 3 of meer keren voorkomt krijg je hem ook twee keer terug.

Problem still remains.

Groet

[Verwijderd]

Ik heb een nieuwe method gebouwd die het probleem oplost:

code:

Sub Array_Unique_Collection(NotUniqueArry As Variant)

    Dim cTmp As New Collection
    Dim i As Long
    Dim aTmp() As Variant
    Dim vElm As Variant

    On Error Resume Next
    For Each vElm In NotUniqueArry
        cTmp.Add CStr(vElm), CStr(vElm)
    Next
    On Error GoTo 0

    ReDim aTmp(1 To cTmp.Count)
    For i = 1 To cTmp.Count
        aTmp(i) = cTmp.Item(i)
    Next
    
    Call PrintArray(aTmp())
End Sub

topic kan gesloten worden. Nog bedankt voor imput..

[Daos]

Verwijderd schreef op vrijdag 20 april 2007 @ 15:28:
Ik heb een nieuwe method gebouwd die het probleem oplost:

Gebouwd in 2004... De oude code was ook al niet van jou.

Zo leer je natuurlijk niets... Bovendien ben je ivm copyrights ook nog strafbaar bezig.

[edit]
Die eerste 0 komt doordat je loopt te kutten met de array-grenzen.
Dim a(5) is hetzelfde als Dim a(0 To 5). Als je a(0) niet vult en wel print, dan staat daar dus een 0:

Visual Basic:

Sub Test()
    Dim a(5) As Integer
    'vullen
    a(1) = 11
    a(2) = 12
    a(3) = 13
    a(4) = 14
    a(5) = 15
    
    'printen
    Dim item
    Dim msg As String
    For Each item In a
        msg = msg & item & ", "
    Next
    MsgBox msg 'geeft 0, 11, 12, 13, 14, 15,
End Sub

Mogelijke oplossingen:
- Tel vanaf 0. Dim a(4), a(0) = 11, a(1) = 12 .. a(4) = 15
- Tel vanaf 1 en laat array ook bij 1 beginnen. Option Base 1 of Dim a(1 To 5)
- Print a(0) niet.

[ Voor 42% gewijzigd door Daos op 20-04-2007 17:41 ]