Wenn alle Zellen unter einer Zelle leer sind, dann

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Wenn alle Zellen unter einer Zelle leer sind, dann

Wenn alle Zellen unter einer Zelle leer sind, dann von AleXSR700 vom 09.09.2019 16:54:32

AW: Wenn alle Zellen unter einer Zelle leer sind, dann - von Nepumuk am 09.09.2019 17:08:50

AW: Wenn alle Zellen unter einer Zelle leer sind, dann - von Daniel am 09.09.2019 17:10:45

AW: Wenn alle Zellen unter einer Zelle leer sind, dann - von mmat am 09.09.2019 17:16:48

AW: Wenn alle Zellen unter einer Zelle leer sind, dann - von onur am 09.09.2019 17:19:51

AW: Leere Bereiche löschen - von GerdL am 09.09.2019 20:32:34

AW: Zusammengefasst... - von Daniel M. am 10.09.2019 13:36:27

AW: Wenn alle Zellen unter einer Zelle leer sind, dann - von AleXSR700 am 13.09.2019 12:26:14

Betrifft: Wenn alle Zellen unter einer Zelle leer sind, dann von: AleXSR700
Geschrieben am: 09.09.2019 16:54:32

Hallo liebe Forumsmitglieder,

ich versuche möglichst "elegant" Bereiche zu überprüfen und dann zu löschen.

Ich habe einen VBA Code geschrieben, der mir eine quasi eine Tabelle in Zeile 10 anlegt und mit Werten füllt.
Sprich, in Zeile 10 schreibt er mir die Infos der Kopfzeile und darunter immer die zugehörigen Werte.

Nun möchte ich gerne, dass er die Tabelle durchgeht und bei jeder Spalte in der unterhalb der Kopfzeile keine Werte stehen, er die Spalte löscht und nach links verschiebt. Er soll dadurch verhindern, dass leere Spalten unnötig in der Tabelle auftauchen.

Ist das irgendwie möglich? Es gibt halt keine bestimmte Orientierungszelle, um ihn ein Do... Loop machen zu lassen bis bspw. Spalte 1 leer ist. Er muss irgendwie einfach schauen, ob irgendeine Zelle unterhalb beschrieben ist.

Von der Logik wäre es ja
1. Prüfe, ob unterhalb von Zelle(10,Column) ALLE Zellen leer sind.
2. Lösche Zelle (10,Column) und alle darunterliegenden (!) Zellen und verschiebe dabei die Zellen nach links.

Vielen Dank für Ihre Hilfe und Ideen!

Viele Grüße

Betrifft: AW: Wenn alle Zellen unter einer Zelle leer sind, dann von: 1712053.html
Geschrieben am: 09.09.2019 17:08:50

Hallo Alex,

so?

Option Explicit

Public Sub DeleteEmtyColumns()
    Dim lngColumn As Long
    For lngColumn = Cells(10, Columns.Count).End(xlToLeft).Column To 1 Step -1
        If Cells(Rows.Count, lngColumn).End(xlUp).Row = 10 Then _
            Call Range(Cells(10, lngColumn), Cells(Rows.Count, lngColumn)).Delete(Shift:=xlShiftToLeft)
    Next
End Sub

Gruß
Nepumuk

Betrifft: AW: Wenn alle Zellen unter einer Zelle leer sind, dann von: 1712054.html
Geschrieben am: 09.09.2019 17:10:45

HI

das geht auch ohne Schleife, wenn man die Spalten per Formel kennzeichnet und über die .SpecialCells die markierten Spalten auswählt:

With ActiveSheet.UsedRange
    With .Rows(.Rows.Count + 1)
        .FormulaR1C1 = "=IF(CountA(R11C:R[-1]C)=0,1,"""")"
        If WorksheetFunction.Sum(.Cells) > 0 Then _
            Intersect(.SpecialCells(xlCellTypeFormulas, 1).EntireColumn, _
                    Range(Rows(10), .EntireRow)).Delete Shift:=xlToLeft
        .ClearContents
    End With
End With

Gruß Daniel

Betrifft: AW: Wenn alle Zellen unter einer Zelle leer sind, dann von: 1712056.html
Geschrieben am: 09.09.2019 17:16:48

löscht eine Spalte unter Beachtung der gesetzten Bedingungen

Sub deletecol(col As Long)
Dim r As Long
  r = Cells(Rows.Count, col).End(xlUp).Row
  If r <= 10 Then Range(Cells(11, col), Cells(Rows.Count, col)).Delete xlShiftToLeft
End Sub

vg, mm

Betrifft: AW: Wenn alle Zellen unter einer Zelle leer sind, dann von: 1712060.html
Geschrieben am: 09.09.2019 17:19:51

Das löscht die komplette Spalte - ich hoffe, du hast nix über der Zeile 10.

Dim last, sp
    For sp = 100 To 1 Step -1 'bis Spalte 100 - ggf ändern
        last = ActiveSheet.Cells(Rows.Count, sp).End(xlUp).Row
        If last = 10 Then Columns(sp).Delete
    Next sp

Betrifft: AW: Leere Bereiche löschen von: 1712098.html
Geschrieben am: 09.09.2019 20:32:34

Hallo,
noch einer.

Sub Makro5()

Dim S As Long

For S = Cells(10, Columns.Count).End(xlToLeft).Column To 1 Step -1

    With Cells(10, S).Resize(Rows.Count - 9, 1)
        If WorksheetFunction.CountA(.Cells) = 1 Then .Delete shift:=xlToLeft
    End With

Next

End Sub

Gruß Gerd

Betrifft: AW: Zusammengefasst... von: 1712255.html
Geschrieben am: 10.09.2019 13:36:27

...würde ich sagen:

Ist das irgendwie möglich?

Ja, das geht :)

Betrifft: AW: Wenn alle Zellen unter einer Zelle leer sind, dann von: 1712875.html
Geschrieben am: 13.09.2019 12:26:14

Hallo euch allen,
vielen herzlichen Dank!
Ich habe mehrere ausprobiert und sie funktionieren sehr gut. Wie viele Wege doch immer wieder nach Rom führen können :-)

Noch einmal: Vielen, vielen Dank für eure rege Hilfe!

Viele Grüße