Makro zu langsam

Sub LeerzeilenAusblenden() Dim ze_zähler As Integer Dim sp_zähler As Integer Dim ZeileBehalten As Boolean Dim zeilenende As Integer Dim a As Range Application.ScreenUpdating = False Set a = ThisWorkbook.Worksheets("Tabelle1").Range("B1:L316") For ze_zähler = a.Rows.Count To 1 Step -1 ZeileBehalten = False For sp_zähler = 1 To a.Columns.Count If a.Cells(ze_zähler, sp_zähler) <> "" Then ZeileBehalten = True: a.Rows(ze_zähler).Hidden = False: Exit For Next sp_zähler If Not ZeileBehalten Then a.Rows(ze_zähler).Hidden = True Next ze_zähler Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub LeerzeilenAusblenden() Dim ze_zähler As Integer Dim sp_zähler As Integer Dim ZeileBehalten As Boolean Dim zeilenende As Integer Dim a As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set a = ThisWorkbook.Worksheets("Tabelle1").Range("B1:L316") For ze_zähler = a.Rows.Count To 1 Step -1 ZeileBehalten = False For sp_zähler = 1 To a.Columns.Count If a.Cells(ze_zähler, sp_zähler) <> "" Then ZeileBehalten = True: a.Rows(ze_zähler).Hidden = False: Exit For Next sp_zähler If Not ZeileBehalten Then a.Rows(ze_zähler).Hidden = True Next ze_zähler Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

Option Explicit Sub LeerzeilenAusblenden() Dim lngZe As Long, intSp As Integer, intSpZ As Integer Dim myCalc As XlCalculation myCalc = Application.Calculation Application.Calculation = xlCalculationManual Application.ScreenUpdating = False With ThisWorkbook.Worksheets("Tabelle1").Range("B1:L316") For lngZe = .Rows.Count To 1 Step -1 intSpZ = .Rows(lngZe).Columns.Count For intSp = 1 To intSpZ If .Cells(lngZe, intSp) <> "" Then Exit For Next intSp If intSp > intSpZ Then Rows(lngZe).Hidden = True Next lngZe End With Application.Calculation = myCalc Application.ScreenUpdating = True End Sub

Sub LeerzeilenAusblenden() Dim lngZe As Long Dim myCalc As XlCalculation Dim lngSP As Long Dim Zelle As Range myCalc = Application.Calculation Application.Calculation = xlCalculationManual Application.ScreenUpdating = False lngSP = Worksheets("Tabelle1").Range("B1:L316").Columns.Count For Each Zelle In Worksheets("Tabelle1").Range("B1:L316").Columns(1).Cells Zelle.EntireRow.Hidden = (WorksheetFunction.CountIf(Zelle.Resize(1, lngSP), "") = lngSP) Next Application.Calculation = myCalc Application.ScreenUpdating = True End Sub

Hallo
da muß ich Erich zustimmen, mit diser Methode wird zuviel ausgeblendet.
aber andersrum sollte es gehen:


Sub tt()
With Range("B1:L316")
.Rows.Hidden = True
On Error Resume Next
.SpecialCells(xlCellTypeConstants).EntireRow.Hidden = False
.SpecialCells(xlCellTypeFormulas).EntireRow.Hidden = False
On Error GoTo 0
End With
End Sub

Dann müssten alle Zeilen eingeblendet sein, in denen mindestens eine Zelle gefüllt ist.
Allerdings funktioniert das Makro nur für Zellen, die wirklich leer sind, also auch keine Formel beinhalten.
Wenn es allerdings so ist, daß alle Zellen Formeln haben, die ggf. einen Leerstring ("") als Ergebnis haben und dann ausgeblendet werden sollen, funktioniert es so natürlich nicht.
Dann muß man das Makro noch einwenig erweiteren:


Sub tt2()
Dim arr
Dim rng As Range
Set rng = Range("B1:L316")
arr = rng.FormulaLocal
With rng
.Formula = .Value
.Rows.Hidden = True
On Error Resume Next
.SpecialCells(xlCellTypeConstants).EntireRow.Hidden = False
.SpecialCells(xlCellTypeFormulas).EntireRow.Hidden = False
On Error GoTo 0
.Value = arr
End With
End Sub

Gruß, Daniel
PS. Floh, wäre schön, wenn du dich mal kurz meldest

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread