AW: Spalten ausblenden, wenn Leer
07.11.2014 15:57:57
fcs
Hallo Björn,
hier ein Makro, das die Spalten ausblendet, in denen unter der Person leere Zellen sichtbar sind.
Alle Daten des Filterbreichs werden in ein Datenarray geladen. Ebenso die Nummern der sichtbaren Zeilen des Filterbereichs.
Anschließend werden die Spalteninhalte auf "" kommt in einer Spalte eine leere Zelle vor, wird die Spalte ausgeblendet.
Gruß
Franz
Sub Test2()
'Spalten ausblenden
Dim Zeile As Long, Zeile1 As Long, Zeile2 As Long, Spalte As Long, StatusCalc As Long
Dim wks As Worksheet
Dim arrData, arrVisible() As Long, bolHide As Boolean, intVisible As Integer
Set wks = ActiveSheet ' = Worksheets("Tabelle1")
'Makrobremsen lösen
With Application
.ScreenUpdating = False
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
'Alle Spalten einblenden
.Columns.Hidden = False
Zeile1 = 3 'Zeile mit Spaltentitel/Personennamen
'Nummer der letzten Zeile des Tabellenobjekts.
With .ListObjects(1).Range
Zeile2 = .Row + .Rows.Count - 1
End With
'letzte Spalte in Zeile mit Spaltentiteln
Spalte = .Cells(Zeile1, .Columns.Count).End(xlToLeft).Column
'Daten des Filterbereichs in Array laden
arrData = .Range(.Cells(Zeile1 + 1, 1), .Cells(Zeile2, Spalte))
'Nummern der sichtbaren Zeilen des Filterbereichs in Array einlesen
For Zeile = Zeile1 + 1 To Zeile2
If .Rows(Zeile).EntireRow.Hidden = False Then
intVisible = intVisible + 1
ReDim Preserve arrVisible(1 To intVisible)
arrVisible(intVisible) = Zeile - Zeile1
End If
Next
'Spalten prüfen und ausblenden wenn leere Zellen vorkommen
For Spalte = 4 To UBound(arrData, 2)
bolHide = False
For intVisible = LBound(arrVisible) To UBound(arrVisible)
If arrData(arrVisible(intVisible), Spalte) = "" Then 'Zelle enthält keinen Text
bolHide = True
Exit For
End If
Next
If bolHide = True Then .Columns(Spalte).EntireColumn.Hidden = True
Next
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = StatusCalc
End With
End Sub