doppelte Zeilen von unten löschen

Forumthread: doppelte Zeilen von unten löschen

unten

Hallo,
ich stehe bei meiner Exceldatei vor folgendem Problem.
In meiner Tabelle befinden sich Daten in den Spalte A-Z. In regelmäßigen Abständen werden von unten Daten angefügt. Teilweise auch mit Leerzeilen
Nun möchte ich, dass die Zeilen. die von Spalte A bis Z komplett identisch sind, von unten (also die neueren Datensätze) gelöscht werden. Die Leerzeilen sollen erhalten bleiben
Die Tabelle darf nicht sortiert oder sonst irgendwie geändert werden.
Die Spalten A-Z sind belegt.
Ich wäre euch dankbar, wenn ihr mir dabei helfen könntet.
Rainer

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: doppelte Zeilen von unten löschen

01.04.2010 15:21:05

unten

Hallo Rainer
Probier mal...

Sub loeschen()
Dim iZeile As Long
Dim iSpalte As Byte
Dim bCheck As Boolean
For iZeile = Range("A65536").End(xlUp).Row To 1 Step -1
bCheck = False
For iSpalte = 1 To 25
If Cells(iZeile, iSpalte)  Cells(iZeile, iSpalte + 1) Or Cells(iZeile, iSpalte) = ""  _
Then
bCheck = True
Exit For
End If
Next iSpalte
If Not bCheck Then Rows(iZeile).Delete
Next iZeile
End Sub

cu
Chris

AW: doppelte Zeilen von unten löschen

01.04.2010 15:22:15

unten

Hallo,
kannst mal diese Variante testen.

Sub Loeschen_Mit_Formel()
Dim oSH As Worksheet, iCalc As Integer
Dim sFormel$, i As Integer
Dim MaxCol As Long, MinCol As Long


Set oSH = Sheets("Tabelle2") 'Tabelle anpassen 

With Application
 iCalc = .Calculation
 .Calculation = xlCalculationManual
 .ScreenUpdating = False
 
  
     With oSH.UsedRange
        MinCol = .Cells(1, 1).Column
        With .Columns(.Columns.Count).Offset(0, 1)
             MaxCol = .Column - 1
             MaxCol = Application.WorksheetFunction.Min(26, MaxCol)
             
             For i = MinCol To MaxCol
                sFormel = sFormel & "RC" & i & "&"
             Next i
             sFormel = "=" & Left$(sFormel, Len(sFormel) - 1)
  
            .FormulaR1C1 = sFormel
            'entsprechende Formel 
            .Offset(0, 1).FormulaR1C1 = _
                "=IF((COUNTIF(R" & .Cells(1, 1).Row & "C[-1]:RC[-1],RC[-1])>1)*(RC[-1]<>""""),TRUE,ROW())"
            
            'sortieren, Tabelle ist mit Überschrift 
            oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes
            
            On Error Resume Next
            .Offset(0, 1).SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
            .Offset(0, 1).EntireColumn.Delete
            .EntireColumn.Delete
            On Error GoTo 0
        
        End With
     End With
 
 .ScreenUpdating = True
 .Calculation = iCalc
End With

End Sub

Gruß Tino

nochmal optimiert.

01.04.2010 18:21:29

Tino

Hallo,
so funktioniert es besser.

Sub Loeschen_Mit_Formel()
Dim oSH As Worksheet, iCalc As Integer
Dim sFormel$, i As Integer
Dim MaxCol As Long, MinCol As Long
Dim sLeer As String

Set oSH = Sheets("Tabelle1") 'Tabelle anpassen 

With Application
 iCalc = .Calculation
 .Calculation = xlCalculationManual
 .ScreenUpdating = False
 
  
     With oSH.UsedRange
        MinCol = .Cells(1, 1).Column
        With .Columns(.Columns.Count).Offset(0, 1)
             MaxCol = .Column - 1
             MaxCol = Application.WorksheetFunction.Min(26, MaxCol)
             
             For i = MinCol To MaxCol
                sFormel = sFormel & "IF(RC" & i & "="""",""|"",RC" & i & ")&"
             Next i
             sFormel = "=" & Left$(sFormel, Len(sFormel) - 1)
             sLeer = String(MaxCol - MinCol + 1, "|")
  
            .FormulaR1C1 = sFormel
            'entsprechende Formel 
            .Offset(0, 1).FormulaR1C1 = _
                "=IF((COUNTIF(R" & .Cells(1, 1).Row & "C[-1]:RC[-1],RC[-1])>1)*(RC[-1]<>""" & sLeer & """),TRUE,ROW())"
            
            'sortieren, Tabelle ist mit Überschrift 
            oSH.UsedRange.Sort Key1:=.Offset(0, 1).Cells(1, 1), Order1:=xlAscending, Header:=xlYes
            
            On Error Resume Next
            .Offset(0, 1).SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
            .Offset(0, 1).EntireColumn.Delete
            .EntireColumn.Delete
            On Error GoTo 0
        
        End With
     End With
 
 .ScreenUpdating = True
 .Calculation = iCalc
End With

End Sub

Gruß Tino

AW: nochmal optimiert.

01.04.2010 21:15:32

Rainer

Hallo!
Vielen Dank für eure Antworten.
Das Makro von Tino funktioniert einwandfrei!
Vielen Dank!
Rainer

Beliebteste Forumthreads (12 Monate)

doppelte Zeilen von unten löschen

Forumthread: doppelte Zeilen von unten löschen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

doppelte Zeilen von unten löschen

Forumthread: doppelte Zeilen von unten löschen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread