Thema: Leere Spalten löschen aber die Überschrift ignorieren

Hallo zusammen,
habe derzeit folgendes Problem:

Ich habe eine relativ große Excel Tabelle und will die leeren Spalten rauswerfen. Allerdings hänge ich derzeit an folgendem Problem: Jede Zeile hat zwei Überschriften, daher will ich ein Makro erstellen, dass ab der dritten Zeile beginnt nach leeren Feldern zu suchen und danach die ganze Spalte zu löschen, wenn es keine befüllten Felder gibt.

Dazu habe ich 2 Makros erstellt. Die erste bereitet die Tabelle vor:

Sub Zentrierung_entfernen_und_unnötige_Felder_löschen()



    Dim lngSpalte As Long

    For lngSpalte = 177 To 21 Step -3



    Rows("1:1").UnMerge

    With ActiveSheet.Range("A1")

   .AutoFilter 19, "x"

    End With



    ActiveSheet.Columns(lngSpalte).EntireColumn.Delete

    Next



    For lngSpalte = 125 To 21 Step -2

    ActiveSheet.Columns(lngSpalte).EntireColumn.Delete

    Next



End Sub

 

Die zweite soll die leeren Felder finden und entfernen und lautet wie folgt:

Sub Leere_Spalten_ab_Zeile_3_löschen()



    Dim lastRow As Long

    Dim lastCol As Long

    Dim i As Long, j As Long

    Dim emptyColumn As Boolean

    

        

    lastRow = Cells(Rows.Count, 1).End(xlUp).Row

    lastCol = Cells(3, Columns.Count).End(xlToLeft).Column

    

    For j = 1 To lastCol

    emptyColumn = True

    For i = 3 To lastRow

    If Cells(i, j) <> "" Then

    emptyColumn = False

    Exit For

    End If

    

    Next i

    If emptyColumn = True Then

    Columns(j).Delete

    j = j - 1

    lastCol = lastCol - 1

    End If

    Next j

End Sub

Die Makros funktionieren zwar einzeln, aber nicht zusammen. Als Beispiel: Wenn ich "Sub Zentrierung_entfernen_und_unnötige_Felder_löschen()" ausführe, verschwinden die unnötigen Felder, aber danach kann ich die leeren Felder mit dem Makro "Sub Leere_Spalten_ab_Zeile_3_löschen()" nicht mehr löschen. Aber wenn ich nur das Makro "Sub Leere_Spalten_ab_Zeile_3_löschen()" ausführe, dann verschwinden die leeren Spalten, aber ich kann die unnörigen Felder mit dem ersten Makro nicht mehr löschen (Da ich es mir einfach gemacht habe und die unnützen Felder mit der Formel "For lngSpalte = 125 To 21 Step -2 ActiveSheet.Columns(lngSpalte).EntireColumn.Delete" entferne.

Hat jemand eine Idee warum ich die Makros in Kombination nicht verwenden kann ? Bin auch dankbar dafür, wenn es eine Möglichkeit gibt die unnötigen Felder sicherer zu löschen. Diese unnützen Felder heißen immer gleich und sind 3 Spalten von einander entfernt.

Vielen Dank und sorry für jegliche Kopfschmerzen die diese Codes bei euch verursachen. Bin in der Anfangsphase :)

auf Verdacht,

Sub Leere_Spalten_ab_Zeile_3_löschen()



    Dim lastCol&, j&

    Dim rng As Range

    lastCol = Cells(3, Columns.Count).End(xlToLeft).Column

    

    If lastCol < 21 Then Exit Sub

    

    Rows("1:1").UnMerge

    Range("A1").AutoFilter 19, "x"



    For j = lastCol To 1 Step -1

        If WorksheetFunction.Countblanc(Range(Cells(3, j), Cells(Rows.Count, j).End(xlUp))) > 0 Then

            If rng Is Nothing Then

              Set rng = Cells(2, j)

            Else

             Set rng = Union(rng, Cells(3, j))

           End If

        End If

    Next j

    

    If Not rng Is Nothing Then rng.entirecolumn.Delete

End Sub

Hi Ralf,

vielen Dank für die schnelle Antwort. Habe deinen Code mal 1:1 übertragen, Excel bringt mir leider Die Fehlermeldung "Laufzeitfehler '438'" im Bezug auf die Zeile
" If WorksheetFunction.Countblanc(Range(Cells(3, j), Cells(Rows.Count, j).End(xlUp))) > 0 Then".

Hab mich mal ran gesetzt und eine entsprechende Bsp. Datei erstellt. Sehr gekürzt und vereinfacht, aber sollte einen Einblick geben.
https://www.herber.de/bbs/user/170844.xlsx
Und dann noch eine Liste, wie es danach aussehen soll.
https://www.herber.de/bbs/user/170845.xlsx

Das Makro müsste folgendes können:

1. Zentrierung in Zeile 1 aufheben
2. Nur nach den mit "x" markierten Zeilen in Spalte "S" filtern
3. Ab Spalte "T" soll nur noch die Spalte mit der Überschrift "LT" übrig bleiben
4. Falls ab Spalte "T" die ganze Spalte unter "LT" leer sein sollte, dann soll die gesamte Spalte gelöscht werden.

Sorry für die Umstände, sitze da schon seit gut einer Woche dran das Makro zu schreiben und verzweifel hier langsam.

Vielen Dank.

Hallo

Es geht auch ohne VBA als PQ-Lösung wenn ich es richtig verstanden habe.
https://www.herber.de/bbs/user/170846.xlsx

Hi Eifeljoi,

leider nein, in meiner 170845 Datei sind alle vollständig leeren Spalten gelöscht. In deiner Datei sind diese Spalten noch da.

Moin
Versuch es mal damit.

Sub Leere_Spalten_ab_Zeile_3_löschen()

    Dim lastCol&, j&

    Dim rng As Range

    lastCol = Cells(3, Columns.Count).End(xlToLeft).Column - 2

    If lastCol < 21 Then Exit Sub

    Rows("1:1").UnMerge

    Range("A1").AutoFilter 19, "x"

    For j = lastCol To 20 Step -3

         If Range(Cells(3, j), Cells(Rows.Count, j).End(xlUp)).SpecialCells(xlVisible).Rows.Count = 2 Then

            If rng Is Nothing Then

              Set rng = Cells(3, j).Resize(1, 3)

               rng.Select

            Else

             Set rng = Union(rng, Cells(3, j).Resize(1, 3))

            End If

         Else

             If rng Is Nothing Then

              Set rng = Cells(3, j + 1).Resize(1, 2)

               rng.Select

            Else

             Set rng = Union(rng, Cells(3, j + 1).Resize(1, 2))

            End If

        End If

    Next j

    If Not rng Is Nothing Then rng.EntireColumn.Delete

End Sub

gruss hary

Kleine Korrektur: Ein anderer User hat eine Lösung vorgeschlagen, die meine Datei korrekt gefiltert hat.
Allerdings ist diese bei der Anwendung auf der Kerndatei leider fehlerhaft und filtert die Datei nur teilweise.
Daher wäre es super, wenn man für diese Datei eine zufriedenstellende Lösung finden könnte:

https://www.herber.de/bbs/user/170859.xlsx

Die Vorlage der korrekt gefilterten Liste ist aktuell.
https://www.herber.de/bbs/user/170845.xlsx

Ich danke euch für eure Mühen.

Hi Floyd,

du hättest ja mal schauen können wo der Fehler ist, anstatt den gleich zurückzuwerfen. ich verrate es dir countblank
deine Beispiel Datei mit dem Wunschergebnis zeigt aber keinen Filter nach "x", außerdem stehen dort drin "X".

wenn man genau weis was du vorhast und eine passende Beispieldatei, dann müssten sich hier nicht so viele Leute drum streiten wer denn den besseren Code hat.

gruß

rb

Hi Hary,

ich habe deine Formel mal in meiner zur Verfügung gestellten Datei getestet, da funktioniert alles.
Aber wenn ich deine Formel auf der richtigen Datei anwenden will, funktioniert die leider nur bis zu einer gewissen Spalte.

Habe mal die vollständige Datei verfremdet und würde diese hier noch einmal hochladen
https://www.herber.de/bbs/user/170859.xlsx

Ich kann mir leider nicht erklären, warum die Kerndatei so ein Problem darstellt :/
Villeicht liegt es ja daran, das wir die Datei aus einem anderen Programm als Export erhalten.

Hoffe ihr helft mir auch weiterhin :)

hi Floyd,

muss es VBA sein?
Es geht mit einigen Formeln für eine einmalige Aktion ganz einfach.
1. Füge zwei Zeilen vor der ersten Zeile ein
2. Zeile1: vergib eine lfd. SpaltenNR, damit die Originalreihenfolge der Spalten wieder hergestellt werden kann.
z.b. A1=1, B1 enthält =A1+1, nach rechts kopieren und Formel durch Daten ersetzen.
3. Zeile2: A2 enthält =ANZAHL2(A3:A1000000), nach rechts kopieren und Formel durch Daten ersetzen.
4. Sortieren der Spalten anhand der Zeile2 Häufigkeit der leeren Zellen in der Spalte.
5. Jetzt kannst du entscheiden welchen Spalten entfernt werden können, diese jetzt löschen
6. Sortieren der Spalten anhand der Zeile 1) - die Originalreihenfolge der Spalten ist hier hinterlegt.

Ergebnis:
1. Unerwünschte Spalten sind entfernt
2. Die verbliebenen Spalten sind wieder in der Originalreihenfolge im Blatt

VBA: kann ich mich heute nicht konzentrieren - sorry.

Gruß,
Firmus

Hi Firmus,

auch dir ein Dankeschön für die schnelle Antwort. Ein Makro wäre schon super, da es ein wöchentliches ToDo ist und wir das dann im Team teilen können.
Wir versuchen den Aufwand so gering wie möglich zu halten.

Grüße,

Hi
mal die Idee von Firmius als VBA umgesetzt.
damit die einzelen Spalten korrekt gelöscht werden können, sollte man die Zellverbünde in der Zeile 1 aufheben und die dortigen Überschriften in alle Spalten übernehmen.
das macht der erste Teil des Codes.
der zweite Teil prüft dann per Formel in ein er Zeile unterhalb der Daten, welche Spalten gelöscht werden können und löscht dann diese.
Der Code nutz aus, dass es in Excel möglich ist, zellen anhand des Datentyps (Text, Zahl, Wahrheitswert, Leerzelle) als Gruppe selektieren zu können.
So kann man sich die Schleife sparen.

Sub löschen()

'--- Zellverbünde Zeile 1 aufheben

Rows(1).UnMerge

With Range(Cells(1, "T"), Cells(2, "T").End(xlToRight).Offset(-1, 0))

    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"

    .Formula = .Value

End With



'--- Spalten löschen

With ActiveSheet.UsedRange

    With Rows(.Rows.Count + 1)

        .FormulaR1C1 = "=IF(Column()<20,"""",If(counta(R3C:R[-1]C),"""",1))"

        .Formula = .Value

        If WorksheetFunction.Sum(.Cells) > 0 Then .SpecialCells(xlCellTypeConstants, 1).EntireColumn.Delete

    End With

End With

End Sub

Gruß Daniel