Herbers Excel-Forum - das Archiv

Bewerten Sie hier bitte das Excel-Portal

Wenn alle Zellen unter einer Zelle leer sind, dann

Bild


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
Bild

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
Bild

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
Bild

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
Bild

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

Bild

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
Bild

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 :)

Bild

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

Excel-Beispiele zum Thema "Wenn alle Zellen unter einer Zelle leer sind, dann"
Makros in Abhängigkeit vom Zellennamen aufrufen Zellen auf Kommentar überprüfen
Spalten bedingt summieren und Zellen formatieren Text aus Textbox in Zellen aufteilen
Zellen vergleichen und markieren Zählen formatierter Zellen
Daten aus Textdatei gezielt in Zellen übernehmen Zellen verbinden und trennen
Zellen bei Minuswerten schraffieren Zeilen oberhalb der markierten Zellen einfügen
Bewerten Sie hier bitte das Excel-Portal