Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
780to784
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
780to784
780to784
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zeilen vergleichen

Zeilen vergleichen
07.07.2006 12:04:32
Tanja
Hallo!
Bin VBA-Neuling und habe ein Probleme.
Mit meiner Abfrage kann ich nur die Daten in Spalte A1 vergleichen.
Ich müßte jedoch Zeile für Zeile, in diesem Falle den Bereich A1:C1, mit der jeweiligen darunter liegenden Zeile vergleichen.
Sofern die Zeile identich ist, wird diese gezählt und anschließend gelöscht.
Wenn nicht, wird der Zähler ausgegeben und wieder auf Null gesetzt. Loop...
Dim box As Variant

Sub doppelteSätzeentfernen()
Sheets("M200512").Activate
ActiveSheet.UsedRange.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:= _
Range("B1"), Order2:=xlAscending, Key3:=Range("C1"), Order3:=xlAscending _
, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
'jetzt doppelte Datensätze rausschmeißen + zählen
box = 1
Range("A1:C1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
box = box + 1
End If
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(0, 3).Select
ActiveCell.Value = box
ActiveCell.Offset(1, -3).Select
box = 1
End If
Loop
End Sub

Hat hier jemand eine Idee?
Danke
Tanja

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen vergleichen
07.07.2006 14:18:50
Martin
Hallo Tanja,
für den 2.-ten Teil (nach erfolgter Sortierung):

Sub doppelte()
Application.ScreenUpdating = False
z = Range("A65536").End(xlUp).Row
box = 1
For i = z To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) And Cells(i, 2) = Cells(i - 1, 2) And Cells(i, 3) = Cells(i - 1, 3) Then
box = box + 1
Rows(i).EntireRow.Delete
Else
Cells(i, 4) = box
box = 1
End If
Next i
Cells(1, 4) = box
Application.ScreenUpdating = True
End Sub

Gruß
Martin Beck
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige