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

Beiträge aus den Excel-Beispielen zum Thema "doppelte dATENSÄTZE LÖSCHEN"