Herbers Excel-Forum - das Archiv

doppelte dATENSÄTZE LÖSCHEN

Bild

Betrifft: doppelte dATENSÄTZE LÖSCHEN
von: Christian

Geschrieben am: 21.03.2005 13:04:17
Hallo,
ich habe eine Datenbank-Tabelle in Excel mit einigen doppelten Datensätzen, die ich löschen möchte. Dazu habe ich mir folgenden Code ausgedacht, der von allen Datensätzen einige Daten in eine Variable pro Datensatz schreibt und dann lass ich die Zeilen miteinander vergleichen und doppelte löschen:
An der markierten Stelle hängt sich der Debugger auf und markiert "Datum" als ungültigen Bezeichner. Was soll das? Ich bin ratlos, vielleicht kann mir jemand helfen. Danke im Voraus
Christian

Private Sub test()
Dim Datum(2000) As Date
Dim Ueb(2000) As Long
Dim SL(2000), TL(2000) As String
Dim Bonus(2000) As Long
Dim i, z, a, b As Long
Dim tempdatum(2000) As Date
Dim tempueb(2000) As Long
Dim tempsl(2000), temptl(2000) As String
Dim tempbonus(2000) As Long
Sheets("Daten").Activate
i = SpecialCells.LastCell.Row
'Sämtliche Daten in Vektoren schreiben
For z = 2 To i
Datum(z) = Cells(z, 1).Date
Ueb(z) = Cells(z, 2).Value
SL(z) = Cells(z, 6).Text
TL(z) = Cells(z, 7).Text
Bonus(z) = Cells(z, 10).Value
Next
'Eine Zeile aussuchen und mit allen anderen vergleichen
For a = 2 To i
tempdatum = Datum(a).Date
tempueb = Ueb(a).Value
tempsl = SL(a).Text
temptl = TL(a).Text
tempbonus = Bonus(a).Value
For b = 2 To i
If b <> a Then
If tempdatum = Datum(b) Then   ****Hier hängt sich der Debugger auf
If tempueb = Ueb(b) Then
If tempsl = SL(b) Then
If temptl = TL(b) Then
If tempbonus = Bonus(b) Then
Rows(b).Delete
End If
End If
End If
End If
End If
End If
Next
Next
End Sub

Bild

Betrifft: AW: doppelte dATENSÄTZE LÖSCHEN
von: Holger Levetzow
Geschrieben am: 21.03.2005 13:08:01
Hallo Christian,
der date-Befehl liest das Systemdatum aus. Das willst Du sicher nicht. Sieh mal unter dateserial oder datevalue nach.
Holger
Bild

Betrifft: AW: doppelte dATENSÄTZE LÖSCHEN
von: Christian
Geschrieben am: 21.03.2005 13:11:45
Danke,
du hast Recht, aber das ändert nichts am eigentlichen Problem...
Bild

Betrifft: AW: Das eigentliche Problem besteht...
von: Luc :-?

Geschrieben am: 21.03.2005 13:25:58
...darin, Christian, dass dein Programm an der fraglichen Stelle ein Datenfeld insgesamt mit dem Einzelwert eines anderen Datenfeldes vergleicht. Du wirst VBA und mir sicher zustimmen, dass das Unsinn ist! tempdatum ist ein Datenfeld, weil du es mit Dim tempdatum(2000) als solches (mit 2001 Einzelfeldern!) deklariert hast. Wenn das so richtig ist, musst du an der fraglichen Stelle einen Einzelwert mit einer Laufvariablen auswählen. Das ist wohl auch nicht der einzige derartige Fehler im Programm!
Gruß Luc :-?
Bild

Betrifft: AW: Das eigentliche Problem besteht...
von: Christian

Geschrieben am: 21.03.2005 13:34:55
Die temp-Werte sollen natürlich keine Datenfelder sein, sondern nur Einzelfelder. Das hab ich natürlich korrigiert. Aber leider ändert auch das nichts daran, dass er mir an der fraglichen Stelle Datum, Ueb, ... als ungültige Bezeichner deklariert.
Kann es vielleicht sein, dass es ein Problem damit gibt eine For-Schleife innerhalb einer anderen laufen zu lassen?

Danke schon mal für eure guten Tipps
Bild

Betrifft: AW: Das eigentliche Problem besteht...
von: Christian

Geschrieben am: 21.03.2005 14:47:29
Gute Nachricht: Es läuft!!!
Wen's interessiert, hier mein Code:
Sub test()
Dim Datum(2000) As Date
Dim SL(2000), TL(2000) As String
Dim Bonus(2000), FM1(2000), FM2(2000), No(2000), X(2000), Rep(2000), i, z, a, b As Long
Sheets("Daten").Activate
i = ActiveCell.SpecialCells(xlLastCell).Row
'Sämtliche Daten in Vektoren schreiben
For z = 2 To i
X(z) = Cells(z, 8).Value
Rep(z) = Cells(z, 9).Value
Datum(z) = Cells(z, 1).Value
SL(z) = Cells(z, 6).Text
TL(z) = Cells(z, 7).Text
Bonus(z) = Cells(z, 10).Value
FM1(z) = Cells(z, 11).Value
FM2(z) = Cells(z, 12).Value
No(z) = Cells(z, 13).Value
Next z
'Eine Zeile aussuchen und mit allen anderen vergleichen
'a ist die Vergleichszeile
'b läuft durch
For a = 2 To i
For b = a + 1 To i
If Rep(a) = Rep(b) Then
If Datum(a) = Datum(b) Then
If X(a) = X(b) Then
If SL(a) = SL(b) Then
If TL(a) = TL(b) Then
If Bonus(a) = Bonus(b) Then
If FM1(a) = FM1(b) Then
If FM2(a) = FM2(b) Then
If No(a) = No(b) Then
Rows(b).Delete
i = i - 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next b
Next a
End Sub

Bild

Betrifft: Dein code sollte nicht laufen...
von: ingoG

Geschrieben am: 21.03.2005 15:05:51
Hallo Christian,
wenn Du 3gleiche zeilen hintereinander stehen hast, wirst Du nicht alle doppelten Zeilen löschen, da dein b zähler schon auf die nächste zeile hochgezählt wird du aber eigentlich die selbe zeilennummer (erste doppelte wurde ja gelöscht) nocheinmal untersuchen müsstest.
Du kannst das prob lösen, in dem du deinen inneren Zeilenzähler runter, anstatt rauflaufen lässt, damit löscht Du nur zeilen nach dem nächsten zeilenzäler.
Du kannst Dir die syntax ja bei meiner lösung (letzte Schleife) anschauen.
Gruß Ingo
PS eine Rückmeldung wäre nett...
Bild

Betrifft: AW: Dein code sollte nicht laufen...
von: Christian

Geschrieben am: 21.03.2005 15:28:13
Hi,
Danke vielmals für die Korrektur!
Ich hab die betreffende For-Zeile umgedreht
von
For b = a + 1 To i
in
For b = i To a + 1 Step -1
Du hattest natürlich recht, aber daran hatte ich nicht gedacht. Es hat mir nochmal zwei Datensätze gelöscht!
Danke
Gruß,
Christian
Bild

Betrifft: Danke für die Rückmeldung oT
von: IngoG
Geschrieben am: 21.03.2005 17:03:37
.
Bild

Betrifft: AW: Das eigentliche Problem besteht...
von: IngoG

Geschrieben am: 21.03.2005 14:44:47
Hallo Christian,
versuchs mal so: (bei mir funzt es...
Gruß Ingo
Sub tttt()
Dim Datum(2000) As Date
Dim Ueb(2000) As Long
Dim SL(2000), TL(2000) As String
Dim Bonus(2000) As Long
Dim loeschen(2000) As Boolean
Dim a, b As Long
Sheets("Daten").Activate
'Sämtliche Daten in Vektoren schreiben
For a = 2 To Range("A2001").End(xlUp).Row
Datum(a) = DateValue(Cells(a, 1))
Ueb(a) = Cells(a, 2).Value
SL(a) = Cells(a, 6).Text
TL(a) = Cells(a, 7).Text
Bonus(a) = Cells(a, 10).Value
loeschen(a) = False
Next
For a = 2 To Range("A2001").End(xlUp).Row
For b = a + 1 To Range("A2001").End(xlUp).Row
If (Datum(a) = Datum(b)) _
And (Ueb(a) = Ueb(b)) _
And (SL(a) = SL(b)) _
And (TL(a) = TL(b)) _
And (Bonus(a) = Bonus(b)) Then
loeschen(b) = True
End If
Next b
Next a
For a = Range("A2001").End(xlUp).Row To 3 Step -1
If loeschen(a) Then Range("A" & a).EntireRow.Delete
Next
End Sub

 Bild
Excel-Beispiele zum Thema "doppelte dATENSÄTZE LÖSCHEN"
Doppelte Einträge finden und löschen Doppelte Datensätze löschen
Doppelte Zelleinträge listen Doppelte Datensätze und Leerzeilen löschen
Doppelte Datensätze farblich markieren und auflisten Doppelte Eingabe von Werten verhinden
In mehrere Spalten doppelte Inhalte entfernen Doppelte Einträge in UserForm-ListBox löschen
Auf Doppelte prüfen, bevor Tabelleneintrag