Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Doppelte Zeilen löschen

Doppelte Zeilen löschen
Takahara
Hallo,
ich habe ein Excel Sheet mit mehreren Spalten.
Ich möchte gucken ob es Werte in der Spalte "B" gibt die doppelt sind. Deshalb durchlaufe ich mit der For-Schleife das Sheet (rückwärts) und lese dabei den aktuellen und den darüber stehenden Wert ein. (Variablen X und V).
Dann möchte ich noch nach einem zweiten Kriterieum aussuchen. Wenn der Wert in der Spalte "O" bei X kleiner ist als bei V, dann soll die Zeile mit dem Index V komplett gelöscht werden. Wenn es anders herum ist, dann soll die andere Zeile gelöscht werden. Haben beide Zeilen den selben Inhalt in der Spalte "O" ist es egal welche von den beiden Zeilen gelöscht wird.
Meinen Code habe ich unten einmal gepostet
Sub doppelt()
Dim zaehler As Integer
Dim i As Integer
Dim v As Double
Dim a As Integer
Dim b As Integer
Application.ScreenUpdating = False
zaehler = Application.CountA(Columns(1))                'Zählt die Anzahl der Zeilen
For i = zaehler To j Step -1
x = Range("B" & CStr(i)).Value
v = Range("B" & CStr(i - 1)).Value
If v = x Then
a = Range("O" & CStr(i)).Value
b = Range("O" & CStr(i - 1)).Value
If a  b Then
Cells(i - 1, 1).EntireRow.Delete
Else
Cells(i, 1).EntireRow.Delete
End If
End If
Next
End Sub

Gruß Takahara

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Doppelte Zeilen löschen
13.10.2010 19:08:56
ChrisL
Hi
Also wenn du die Tabelle sowieso vorher sortieren musst, kannst du gleichzeitig nach Spalte B und O sortieren. Damit wäre der Vergleich in der Schleife nur noch ob Cells(i,2)=Cells(i-1,2) und könntest direkt löschen. Zudem ist mir aufgefallen, dass die Variable j nicht definiert ist.
Jedenfalls habe ich dir das ganze so gestaltet, dass es ganz ohne Sortierung auskommt. Erfordert zwei Schleifen, was die Sache etwas langsamer macht.
cu
Chris
Sub doppelt()
Dim zaehler As Long
Dim i As Long
Application.ScreenUpdating = False
zaehler = Range("B65536").End(xlUp).Row
For i = zaehler To 1 Step -1
If i MaxWenn(Cells(i, 2)) Then Rows(i).Delete
Next
Application.ScreenUpdating = True
End Sub
Private Function MaxWenn(SuchNummer As Double) As Long
' Funktion gibt die Zeilennummer zurück mit dem höchsten Wert in Spalte O
Dim i As Long
Dim ErgebnisZeile As Long
For i = 1 To Range("B65536").End(xlUp).Row
If Cells(i, 2) = SuchNummer Then
If ErgebnisZeile > 0 Then
If Cells(i, 16) > Cells(ErgebnisZeile, 16) Then ErgebnisZeile = i
End If
ErgebnisZeile = i
Else
End If
Next i
MaxWenn = ErgebnisZeile
End Function

Anzeige

313 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige