Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.10.2025 17:57:35
Zellen-Name aus A1 nach H1 übertragen mit Prä- + Suffix
17.10.2025 11:36:58
verschachteltes Dropdown-Menü
17.10.2025 10:28:49
Call Anweisung
16.10.2025 18:38:17
Zusammenfassung nach Personalnummer
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
928to932
928to932
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Automatisiert Zeilen löschen?

Forumthread: Automatisiert Zeilen löschen?

Automatisiert Zeilen löschen?
29.11.2007 20:34:50
Michael
Hallo!
Ich arbeite an einem Sheet mit 1711 Zeilen. Die erste Zeile beinhaltet die Spaltenüberschriften.
Danach beginnt mein Problem:
Immer je drei Zeilen beziehen sich auf einen Datensatz. Pro Datensatz benötige ich aber lediglich immer
die erste Zeile. Die Zeilen 2 und 3 jedes Datensatzes möchte ich gerne löschen.
Beispiel:
Zeile
1 Spaltenüberschriften
2 Datensatz1 - behalten
3 Datensatz 1 - löschen
4 Datensatz 1 - löschen
5 Datensatz 2 - behalten
6 Datensatz 2 - löschen
7 Datensatz 2 - löschen
..........
...........
Alle zu löschenden Zeilen per Hand zu löschen möchte ich nur ungern ;-)) tun. Zumal ich ähnliche Sheets
auf 8 Arbeitsblättern habe.......
Kann man da irgendetwas automatisieren?
Gruss aus Hannover!
Michael

Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatisiert Zeilen löschen?
29.11.2007 20:44:00
Peter
Hallo Michael,
das sollte z. B. so gehen

Sub loeschen()
Dim lLetzte  As Long
Dim lZeile   As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
lLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
For lZeile = lLetzte To 2 Step -3
Rows(lZeile - 0).Delete Shift:=xlUp
Rows(lZeile - 1).Delete Shift:=xlUp
Next lZeile
End With
Application.ScreenUpdating = True
End Sub


Gruß Peter

Anzeige
AW: Automatisiert Zeilen löschen?
29.11.2007 20:47:54
Josef
Hallo Michael,
wie viele Spalten umfasst deine Tabelle?
Gruß Sepp

AW: Automatisiert Zeilen löschen?
29.11.2007 21:02:08
Michael
Hallo Sepp!
17 Spalten.
Gruss

AW: Automatisiert Zeilen löschen?
29.11.2007 21:26:00
Josef
Hallo Micheal,
probier mal. (bezieht sich immer auf das gerade aktive Tabellenblatt!)
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Duplikate()
Dim lngR As Long, intC As Integer

On Error GoTo ErrExit
GMS

With ActiveSheet
    lngR = .Cells(Rows.Count, 1).End(xlUp).Row
    intC = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
    
    .Cells(1, intC) = "###"
    
    .Range(.Cells(2, intC), .Cells(lngR, intC)).Formula = _
        "=COUNTIF($A$2:A2,A2)<>1"
    
    .Range(.Cells(2, intC), .Cells(lngR, intC)) = _
        .Range(.Cells(2, intC), .Cells(lngR, intC)).Value
    
    .Range("A1").CurrentRegion.Sort _
        key1:=.Cells(1, intC), _
        order1:=xlDescending, _
        header:=xlYes
    
    .Range("A1").AutoFilter _
        Field:=intC, _
        Criteria1:="=true"
    
    On Error Resume Next
    .Range(.Cells(2, 1), .Cells(lngR, intC)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Err.Clear
    On Error GoTo ErrExit
    
    .Columns(intC).Delete
    
    .Range("A1").AutoFilter
    
    .Range("A1").CurrentRegion.Sort _
        key1:=.Cells(1, 1), _
        order1:=xlAscending, _
        header:=xlYes
    
End With

ErrExit:
If Err.Number <> 0 Then MsgBox Err.Number & vbLf & Err.Description
GMS True

End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long

With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Modus Then
        .Calculation = IIf(lngCalc <> 0, lngCalc, xlCalculationAutomatic)
    Else
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End If
    .Cursor = IIf(Modus, -4143, 2)
    .CutCopyMode = False
End With

End Sub

Gruß Sepp

Anzeige
AW: Automatisiert Zeilen löschen?
29.11.2007 21:24:21
Michael
DANKE!!!!!
Es hat sofort funktioniert! Genial!
Das könnte ich auch gerne.... ;-))
Gruss,
Michael
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige