1.4k Aufrufe
Gefragt in Tabellenkalkulation von ahorn38 Experte (3.2k Punkte)
Hallo,

ich versuche mich an einem Code mit dem ich Duplikate in einem vorher eingelesenen Array finde.

Sub Duplikate()

Dim arrSpeicher() As String, lngAnz As Long

For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
ReDim Preserve arrSpeicher(0 To lngAnz)
arrSpeicher(lngAnz) = Cells(i, 2) & Cells(i, 3) & Cells(i, 5) & Cells(i, 7) & Cells(i, 9)
lngAnz = lngAnz + 1
Next

For i = 0 To UBound(arrSpeicher(), 1) ' kontrolliert , ob Datensätze doppelt sind
If Application.Count(arrSpeicher(), arrSpeicher(i)) > 1 Then
.....


Allerdings liefert mir die count-Funktion ausnahmslos den Wert "0", obwohl der doch jedesmal mindestens "1" ergeben müßte.
Was läuft da falsch? Danke für euren Tipp.
Gruß Andreas

13 Antworten

0 Punkte
Beantwortet von
Hi Andreas ^^

Nutze den Spezialfilter um Doppelte auszublenden
Diese gefilterten Daten dann in ein Array

Gruss Nighty
0 Punkte
Beantwortet von ahorn38 Experte (3.2k Punkte)
Hi nighty,

du meinst sicher den Excel-Befehl "Duplikate", oder?
Das hilft mir nur nicht weiter, weil ich zu diesem Zeitpunkt keinen "Zugriff" auf die Ausgangs-Datei habe.
Ich will alle relevaten Datensätze als string in das Array einlesen, dann prüfen, welche doppelt sind und anschließend über die Position im Array wieder die (letzten) Doppelten Datensätze in der Ausgangsdatei löschen.
Gruß A.
0 Punkte
Beantwortet von ahorn38 Experte (3.2k Punkte)
Hi nochmal,

da das mit den Zählen bei mir nicht klappt, habe ich etwas umständlich jetzt folgende funktionierende Lösung...

Sub Duplikate()

Dim arrSpeicher() As String, lngAnz As Long

For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
ReDim Preserve arrSpeicher(0 To lngAnz)
arrSpeicher(lngAnz) = Cells(i, 2) & Cells(i, 3) & Cells(i, 5) & Cells(i, 7) & Cells(i, 9)
lngAnz = lngAnz + 1
Next

For i = 0 To UBound(arrSpeicher(), 1) - 1 ' kontrolliert , ob Datensätze doppelt sind
For j = 1 + i To UBound(arrSpeicher(), 1)
If arrSpeicher(i) = arrSpeicher(j) Then
Cells(j + 3, 2).Interior.ColorIndex = 45 ' - Zeile muß korrespondieren mit Startzelle in array!
End If
Next
Next

Falls jemand was besseres hat, bin ich für jeden Vorschlag dankbar!!
VG Andreas
0 Punkte
Beantwortet von
hi Andreas ^^

Wenn du die Daten vorher sortierst,brauchst du nur eine schleife!
Vergleich auf nachfolgenden Wert!

Gruss Nighty
0 Punkte
Beantwortet von
hi Andreas ^^

Sortierung über Excel oder Quicksort

QuickSort Modul

'Option Compare Binary ' keep case
'Option Compare Text ' ignore case
Sub TestIt()
Dim ar(2 To 5) As Variant, i As Long
For i = 2 To 5
ar(i) = Cells(i, 1)
Next
QuickSort_Feld ar, 2, 5, False
For i = 2 To 5
Cells(i, 2) = ar(i)
Next
End Sub
Private Sub QuickSort_Feld(DasFeld, StartUnten, EndeOben, Absteigend As Boolean)
Dim iUnten As Long, iOben, iMitte, y
iUnten = StartUnten
iOben = EndeOben
iMitte = DasFeld((StartUnten + EndeOben) / 2)
While (iUnten <= iOben)
If Not Absteigend Then
While (DasFeld(iUnten) < iMitte And iUnten < EndeOben)
iUnten = iUnten + 1
Wend
While (iMitte < DasFeld(iOben) And iOben > StartUnten)
iOben = iOben - 1
Wend
Else
While (DasFeld(iUnten) > iMitte And iUnten < EndeOben)
iUnten = iUnten + 1
Wend
While (iMitte > DasFeld(iOben) And iOben > StartUnten)
iOben = iOben - 1
Wend
End If
If (iUnten <= iOben) Then
y = DasFeld(iUnten)
DasFeld(iUnten) = DasFeld(iOben)
DasFeld(iOben) = y
iUnten = iUnten + 1
iOben = iOben - 1
End If
Wend
If (StartUnten < iOben) Then Call QuickSort_Feld(DasFeld, StartUnten, iOben, Absteigend)
If (iUnten < EndeOben) Then Call QuickSort_Feld(DasFeld, iUnten, EndeOben, Absteigend)
End Sub


Gruss Nighty
0 Punkte
Beantwortet von ahorn38 Experte (3.2k Punkte)
Hi nighty,
prima, danke!
Aber kannst du mir interessenhalber auch noch sagen warum der code mit dem count.....(s. o.) nicht funktioniert?
Danke und Gruß A.
0 Punkte
Beantwortet von
Hallo Andreas,

das kann ich dir sagen. Du hast hier Count, also das englische Pendant zu =Anzahl verwendet, wolltest aber CountIf verwenden.
Stattdessen zählst du also Alle Zahlen in einem Array, das ausschließlich Text enthält und addierst als zweiten Parameter noch
einen anderen Wert der ebenfalls Text ist. Im Ergebnis kommt deshalb 0 raus.

Leider kannst du CountIf aber auch nicht verwenden, da diese Funktion an erster Stelle ein Range-Objekt verlangt und somit nicht
mit einem Array funktioniert.

Alternative wäre die SumProduct-Funktion. Leider habe ich bislang noch nicht rausgefunden, wie man die in VBA mit einem Array
verwenden kann. Da bin ich noch dran. Falls jemand schneller ist, immer her mit der Lösung. :-)

Gruß Mr. K.
0 Punkte
Beantwortet von ahorn38 Experte (3.2k Punkte)
Danke Mr.K. für die Aufklärung! Wäre natürlich interessant zu wissen, wie man in einem array die Anzahl gleicher string-Elemente ermitteln kann....
Viele Grüße A.
0 Punkte
Beantwortet von
hi ihr beiden ^^

Ich sehe mit Summenprodukt und Arrays kein Problem ?

Ein Beispiel mit zwei Matritzen!

Sub Makro1()
Dim arrdat0 As Variant, arrdat1 As Variant
arrdat0 = Range("A2:A4")
arrdat1 = Range("B2:B4")
Range("A1") = Application.WorksheetFunction.SumProduct(arrdat0, arrdat1)
End Sub


Gruß Nighty
0 Punkte
Beantwortet von
Eben. Aber ich muss an dieser Stelle leider aufgeben, da ich nicht denke, dass es dafür eine Lösung in der gewünschten Form
gibt. SumProduct in VBA ist offenbar einfacher gestrickt, als die Funktion in Excel. Man kann als Parameter zwar ein RangeObjekt
oder ein Array verwenden, beide Parameter müssen aber gleich groß sein. Eine Bedingung wie im Excel lässt sich leider nicht
hinzufügen, da es sich dann bei dem Parameter um einen Wahrheitswert oder einen String und nicht mehr um ein Array handelt.
Für Range-Objekte wird im Netz daher immer auf die Evaluate-Funktion verwiesen. Ein Array lässt sich in dieser Form aber leider
nicht einbauen. :-(

Falls doch jemand eine Lösung findet, würde diese mich natürlich auch interessieren. Ich für meinen Teil bin an dieser Stelle
raus.
...