[VBA] Array filteren op unieke records

[Verwijderd]

Goeiesmorgens,

Ik heb inmiddels een gesorteerde array alleen komen waardes dubbel voor. De volgende stap is dus het filteren op unieke records. Ik heb daarvoor onderstaande method geschreven maar die werkt niet helemaal lekker. Hij neemt namelijk de laatste en grootste numerieke waarde niet mee in de gefilterde array. Dit zijn de resultaten:

Array(alle waarden) Array na filteren
100 0
200 100
300 200
300 300
777777777 500
500 0

Tussendoor wordt de eerste array nog gefilterd en dat ziet er prima uit alleen heeft ie dan een 0 extra maar daar kan ik mee leven. De gesorteerde array ziet er zo uit:

0
100
200
300
500
777777777

De filter functie die dus niet goed gaat ziet er zo uit:

code:

Private Sub Filter(ToFilter() As Long)

Dim x
Dim Filter As Long
Dim temp() As Long
x = 1
      
    For Filter = LBound(ToFilter) + 1 To UBound(ToFilter) - 1
            If (ToFilter(Filter) <> ToFilter(Filter + 1)) Then
                ReDim Preserve temp(x + 1)
                temp(x) = ToFilter(Filter)
                MsgBox "The job is done ! " & temp(x)
                x = x + 1
                    
            End If
    Next Filter
   

Call PrintArray(temp())

End Sub

Kan iemand me misschien helpen, ik ben al een tijdje aan het kloten maar kom er niet uit. Dank is groot.

Groet

[NMe]

Waar hoort mijn topic?

PRG>>OFF

Ik heb meteen je vorige topic ook nog even alsnog in Officesuites en -software gezet, omdat het daar beter past.

[onkl]

Nogal wiedus dat die laatste waarde verdwijnt: UBound(ToFilter) - 1
Maar, je loop aanpassen werkt niet helemaal, immers, de "ToFilter(Filter) <> ToFilter(Filter + 1)" regel kan geen Filter+1 waarde vinden bij de laatste waarde.
Die laatste 0 komt omdat de lengte van je temparray altijd 1 regel "voorloopt" op het aantal waardes.
Dus, een kleine aanvulling na je loopje, waarbij we gebruik maken van de wetenschap dat
-De laatste waarde er altijd inmoet (immers, als de voorlaatste eraan gelijk is, zal die niet in temp staan
-de laatste waarde van temparray altijd nul is en overschreven mag worden.

code:

Private Sub Filter(ToFilter() As Long)

Dim x
Dim Filter As Long
Dim temp() As Long
x = 1
      
    For Filter = LBound(ToFilter) + 1 To UBound(ToFilter) - 1
            If (ToFilter(Filter) <> ToFilter(Filter + 1)) Then
                ReDim Preserve temp(x + 1)
                temp(x) = ToFilter(Filter)
                MsgBox "The job is done ! " & temp(x)
                x = x + 1
                    
            End If
    Next Filter
temp(Ubound(temp))=ToFilter(Ubound(ToFilter))

Call PrintArray(temp())

End Sub

[ Voor 5% gewijzigd door onkl op 20-04-2007 11:05 ]