Doppelte Zeile löschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Doppelte() Dim LoI As Long Dim LoLetzte As Long LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 4)), Cells(Rows.Count, 4).End(xlUp).Row, Rows. _ Count) For LoI = LoLetzte To 1 Step -1 If WorksheetFunction.CountIf(Range(Cells(LoLetzte, 4), Cells(LoI, 4)), Cells(LoI, 4)) > _ 1 Then Rows(LoI).Delete End If Next LoI End Sub

Hallo Matthias, hallo Hajo,
zunächst mal sorry an Matthias, natürlich hast Du Recht und ich wollt Dich auch nicht ignorieren, ist einfach passiert in der Hektik grade hier bei mir. Deshalb , wenn auch verspätet, DANKE an Dich.
Ich bin übrigens schon so oft so froh gewesen, dass es Leute wie Euch gibt....
Nun komme ich nochmal mit einer Bitte um Hilfe, denn meine Arbeitsmappen, in denen das Makro greift sind sehr groß. Nun habe ich eben erst rausgefunden, dass das Makro auf jeden Fall die "Doppelten" rausholt wie gewünscht und dabei aber auch andere Zahlenreihen mit löscht (bei 8000 Datensätze etwa 20 zuviel / zu unrecht, das ist zwar nicht viel, aber eben doch schlecht für meine Auswertung..). Nur kann ich den Grund dafür nicht finden. Möglichwerweise deshalb, weil es Zahlenreihen gibt, die in den ersten 15 Ziffern gleich sind und nur die letzten 3 oder 4 sind anders. Das dürfte aber doch normal nichts ausmachen, oder?
Vielleicht habt Ihr eine Idee, DANKE
Elmar

Hallo Elmar,
bei dem Vorschlag von Hajo werden scheinbar die Inhalte der Zellen in dem Range VBA-intern in Zahlen umgewandelt. Da Excel nur 15 signifikante Ziffern verwaltet werden die 18 Ziffern langen Zeichenfolgen als Zahlen gerundet und es kommt zu scheinbaren Dopplungen.
Da die Dopplungen jeweils in aufeinander folgenden Zeilen stehen kann man auch mit einem direkten Vergleich der Zellinhalte arbeiten.
Gruß
Franz

Sub Doppelte_2()
Dim LoI As Long, LoCount As Long
Dim LoLetzte As Long
Application.ScreenUpdating = False
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 4)), Cells(Rows.Count, 4).End(xlUp).Row, _
Rows.Count)
'bei allen Doppelten den Eintrag in der 1. Zeile löschen
For LoI = LoLetzte To 1 Step -1
If Cells(LoI, 4) = Cells(LoI + 1, 4) Then
'        If Cells(LoI, 4).Text = Cells(LoI + 1, 4).Text Then
Cells(LoI, 4).ClearContents
LoCount = LoCount + 1
End If
Next LoI
Application.ScreenUpdating = True
If LoCount > 0 Then
'Alle leeren Zellen in Spalte D löschen
With Range(Cells(1, 4), Cells(LoLetzte, 4)).SpecialCells(xlCellTypeBlanks)
.EntireRow.Delete
End With
End If
MsgBox "es wurden " & LoCount & " doppelte gelöscht"
End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread