Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1072to1076
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
Inhaltsverzeichnis

Inhalte zusammenfassen / leere Zeilen löschen

Inhalte zusammenfassen / leere Zeilen löschen
11.05.2009 07:07:23
StefanS
Hallo zusammen,
habe folgendes Problem:
Ein Registerblatt (siehe Excel-Datei) kann mehrere Items unter der gleichen Section enthalten. Nun meine Frage: Besteht die Möglichkeit die leeren Zeilen zwischen Items der gleichen Section zu löschen? Vielleicht ist meine Beschreibung nicht so ganz eindeutig - werft doch bitte mal einen Blick in die Beispiel-Datei, danke.
https://www.herber.de/bbs/user/61726.xls
Gruß, Stefan

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Inhalte zusammenfassen / leere Zeilen löschen
11.05.2009 08:35:20
David
Hallo Stefan,
so:

Sub löschen()
For i = Range("B65000").End(xlUp).Row To 2 Step -1
If Cells(i, 2) = "" Then
If Cells(i - 1, 2) = Cells(i + 1, 2) Then Rows(i).EntireRow.Delete
End If
Next
End Sub


Ist nicht besonders schnell, d.h. wenn deine Echttabelle tausende Zeilen hat, sollte man an das Makro noch Hand anlegen.
Gruß
David

AW: Inhalte zusammenfassen / leere Zeilen löschen
11.05.2009 12:42:57
StefanS
Hallo David,
super - danke! Funktioniert einwandfrei!!!!
Vielen Dank, Stefan
AW: Inhalte zusammenfassen / leere Zeilen löschen
11.05.2009 08:35:34
Tino
Hallo,
geht es so?
Sub Makro1()
Dim Bereich As Range
Dim iCalc As Integer

With Application
 iCalc = .Calculation
 .ScreenUpdating = False
 .EnableEvents = False
 .Calculation = xlCalculationManual
    
    Set Bereich = Range("B4", Cells(Rows.Count, 1).End(xlUp).Offset(0, 1))
    Set Bereich = Bereich.Offset(0, Columns.Count - Bereich.Column)
    
    Bereich.FormulaR1C1 = "=IF(AND(R[-1]C2=R[1]C2,RC2=""""),0,"""")"
    
    If .WorksheetFunction.CountIf(Bereich, 0) > 0 Then
     Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
    End If
    
    Columns(Columns.Count).Delete
 
 .Calculation = iCalc
 .ScreenUpdating = True
 .EnableEvents = True
End With

End Sub


Gruß Tino

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige