Die folgenden Beispiel-Makros prüfen das aktuelle Arbeitsblatt Zeilen- und Spaltenweise. Leere Spalten und/oder Zeilen werden dabei ausgeblendet.
Option Explicit
' ************************************************************************************************
' Autor/en: http://www.online-vba.de - Marc Wershoven
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von www.online-vba.de!
' Original-Quelltext: www.online-vba.de/vba_leerezsausblenden.php
' ************************************************************************************************
Public Sub LeereSpaltenUndZeilenAusblenden()
Call LeereSpaltenAusblenden
Call LeereZeilenAusblenden
End Sub
Public Sub LeereSpaltenAusblenden()
Dim s As Long
Dim sMAX As Long
Dim z As Long
Dim zMAX As Long
Dim bAusblenden As Boolean
sMAX = ActiveSheet.UsedRange.Columns.Count + ActiveSheet.UsedRange.Column - 1
zMAX = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1
Application.ScreenUpdating = False
'Schleife über alle Spalten
For s = 1 To sMAX
'Pro Spalte prüfen wir alle Zellenwerte, ob irgendwo etwas eingetragen ist.
'Ist etwas eingetragen wird die Zeile nicht ausgeblendet.
bAusblenden = True
For z = 1 To zMAX
If Trim(CStr(ActiveSheet.Cells(z, s).Text)) <> "" Then
bAusblenden = False
Exit For
End If
Next z
If bAusblenden = True Then
ActiveSheet.Columns(s).EntireColumn.Hidden = True
End If
Next s
Application.ScreenUpdating = True
End Sub
Public Sub LeereZeilenAusblenden()
Dim s As Long
Dim sMAX As Long
Dim z As Long
Dim zMAX As Long
Dim bAusblenden As Boolean
sMAX = ActiveSheet.UsedRange.Columns.Count + ActiveSheet.UsedRange.Column - 1
zMAX = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1
Application.ScreenUpdating = False
'Schleife über alle Zeilen
For z = 1 To zMAX
'Pro Zeile prüfen wir alle Zellenwerte, ob irgendwo etwas eingetragen ist.
'Ist etwas eingetragen wird die Zeile nicht ausgeblendet.
bAusblenden = True
For s = 1 To sMAX
If Trim(CStr(ActiveSheet.Cells(z, s).Text)) <> "" Then
bAusblenden = False
Exit For
End If
Next s
If bAusblenden = True Then
ActiveSheet.Rows(z).EntireRow.Hidden = True
End If
Next z
Application.ScreenUpdating = True
End Sub
Autor: Marc Wershoven (2017)
VBA Programmierer gesucht?
http://www.WershovenOnline.de
Sie haben beispielsweise eine Frage zu einer Ihrer eigenen Makroprogrammierungen in VBA? Oder Sie suchen Unterstützung und Informationen über eine bestimmte Microsoft® Excel® Formel? Bei nahezu allen Fragen und Problemen rund um Microsoft® Office und VBA Makros steht Ihnen unser individueller Quick E-Mail Support zur Verfügung. Einfach, schnell und unkompliziert Ihre Frage in einer E-Mail formulieren, mit oder ohne Screenshots oder einer Beispieldatei absenden und kurze Zeit später haben Sie eine vollständige Lösung inkl. ausführlicher Erklärung vom Profi in Ihrem Postfach!
Zusätzlich besteht die Option, dass wir uns mittels Fernwartung (selbstverständlich nach Ihrem Einvertändnis) direkt "live" mit Ihnen zusammen an Ihrem Bildschirm gemeinsam Fragen und Problemstellungen anschauen und lösen können!
Weitere Informationen zu diesem kostenpflichtigen Angebot finden Sie auf der Anbieterseite von WershovenOnline® auf www.wershovenonline.de.
Zum Anbieter des Quick-E-Mail-Support...