Tippseite

VB-Homepage Tipp 259

Doppelte Werte in Array ermitteln und löschen

Um Arrays kommt sicher niemand ernsthaft umhin, wenn er mit vielen Daten arbeitet. Nun nehmen wir mal an, ein Array enthält keine Daten, die Statisch sind und nur zum Abrufen bereit stehen, sondern werden vom User modifiziert bzw. überhaupt erst angelegt.

Und nehmen wir weiter an, diese Daten dürfen oder sollten nicht doppelt vorhanden sein.

Was also, wenn man vermeiden muß oder will, das doppelten Daten verwendet oder abgespeichert werden. Na ganz einfach, nutzen Sie fortan diesen Tipp .

Für ein Beispiel benötigen wir ein neues Projekt.

Dem gönnen Sie bitte zwei Listbox Controls (List1 & List2) und einen Command-Button (Command1).

Wir werden dann beim Starten, das erste Listboxcontrol mit den Zahlen 1 bis 100 füllen und einige Werte (damit wir was zum testen haben) mit der gleichen Zahl (10000) füllen.

So haben Sie in der ersten Listbox die Übersicht über alle 100 Werte unseres Arrays vor der Aktion.

Über den Command Button werden wir die Aktion (Suchen und Löschen dopp. Werte) auslösen und dann erneut alle Werte in die zweite Listbox eintragen. So ist ein direkter Vergleich möglich, und von unseren 10000 Werten darf dann nur noch einer drin stehen.

Also dann, auf zum Test.

Allgemein / Deklarationen
Dim meinarray(100) As Integer 'Unser Array für numerische Werte

Allgemein / RemoveDupes
Public Function RemoveDupes(vData As Variant)

' Ist vData kein Array - Beenden
If Not IsArray(vData) Then Exit Function

Dim lCurIndex As Long
Dim lNextIndex As Long
Dim lNewIndex As Long
Dim i As Long
Dim Hi As Long
Dim vtemp As Variant

Hi = UBound(vData) + 1

lNewIndex = 1
i = 1
ReDim tmpAray(1 To Hi) As String

Do
   If Len(vData(i)) <> 0 Then
      tmpAray(lNewIndex) = vData(i)
      Exit Do
   End If
   i = i + 1
Loop

i = i + 1
For lCurIndex = i To Hi
   lNextIndex = lCurIndex + 1
   vtemp = ""
   If lNextIndex > Hi Then Exit For
   If vData(lCurIndex) = tmpAray(lNewIndex) Then
      vData(lCurIndex) = ""
   End If
   If Len(Trim(vData(lCurIndex))) > 0 Then
      vtemp = vData(lCurIndex)
      If IsInArray(vData, vtemp, lNextIndex) Then
         'vData(lCurIndex) = "" 'bei Zeichenketten
         vData(lCurIndex) = 0 'bei Numerischen Werten
      Else
         lNewIndex = lNewIndex + 1
         tmpAray(lNewIndex) = vtemp
      End If
   End If
Next

ReDim vData(1 To Hi) As String

For lCurIndex = 1 To Hi
vData(lCurIndex) = tmpAray(lCurIndex)
List2.AddItem vData(lCurIndex) 'Eintragen der Werte in zweite Listbox
Next

End Function

Allgemein / IsInArray
Private Function IsInArray(vData As Variant, vSrchData As Variant, lStart As Long) As Boolean

If Not IsArray(vData) Then Exit Function
Dim Hi As Long
Hi = UBound(vData)

Do Until lStart > Hi
   If StrComp(vData(lStart), vSrchData, 0) = 0 Then
      IsInArray = True
      Exit Function
   End If
   lStart = lStart + 1
Loop

IsInArray = False
End Function

Form / Load
For i = 1 To 100 'Array füllen
meinarray(i) = i
Next i

meinarray(60) = 10000 'doppelte Werte im Array setzen
meinarray(70) = 10000
meinarray(80) = 10000
meinarray(90) = 10000

For i = 1 To 100 'Werte in Listbox eintragen
List1.AddItem meinarray(i)
Next i

Command1 / Click
' hier wird einfach nur der Prozedur der entsprechende Arraynamen übergeben,
es ist also 'sehr gut auch für viele Arrays nutzbar.

RemoveDupes (meinarray)

Starten Sie Ihr neues Projekt mit F5 und lösen Sie die Aktion mit einem Klick auf den Button aus. Sehen Sie, ... (doch, aber nur einmal)

Tipp-Download

Quelle : Kenneth Ives in VBTT