Leere Zeilen nicht drucken. Makro optimieren

Hallo,
das Makro durchsucht Bereiche und blendet Zeilen aus, wenn in Spalte C die Zellen leer sind um dann das Blatt zu drucken.

Sub print_n()
Dim iCol As Integer
Dim i As Integer
Dim iRow As Integer
Dim iRowL As Integer
Dim i2 As Integer
Dim iRow2 As Integer
Dim iRowL2 As Integer
iCol = 3
iRow = 34 '1. Bereich
iRowL = 38
iRow2 = 40 '2. Bereich
iRowL2 = 44
For i = iRow To iRowL
If Cells(i, iCol) = 0 Then Rows(i).EntireRow.Hidden = True
If Cells(i, iCol) = 0 Then Rows(i + 1).EntireRow.Hidden = True
Next
For i2 = iRow2 To iRowL2
If Cells(i2, iCol) = 0 Then Rows(i2).EntireRow.Hidden = True
If Cells(i2, iCol) = 0 Then Rows(i2 + 1).EntireRow.Hidden = True
Next
'Drucken
For i = iRow To iRowL + 1
If Rows(i).Hidden = True Then Rows(i).EntireRow.Hidden = False
Next
For i2 = iRow2 To iRowL2 + 1
If Rows(i2).Hidden = True Then Rows(i2).EntireRow.Hidden = False
Next
End Sub

Das Makro ist eine optische Katastrophe und sehr langsam.
Weis jemand wie man das Makro optimieren kann?
Vorab vielen Dank. Grüße chandler

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub print_n() Dim rng As Range Dim lngCol As Long, lngIndex As Long, lngStart As Long, lngEnd As Long lngCol = 3 lngStart = 34 '1. Bereich lngEnd = 38 For lngIndex = lngStart To lngEnd If Cells(lngIndex, lngCol) = 0 Then If rng Is Nothing Then Set rng = Rows(lngIndex) Else Set rng = Union(rng, Rows(lngIndex)) End If End If If Cells(lngIndex + 6, lngCol) = 0 Then If rng Is Nothing Then Set rng = Rows(lngIndex) Else Set rng = Union(rng, Rows(lngIndex)) End If End If Next If Not rng Is Nothing Then rng.EntireRow.Hidden = True 'Drucken Range(Cells(lngStart, 1), Cells(lngEnd + 6, 1)).EntireRow.Hidden = False End Sub

Sub xxx() Dim Rng As Range Application.ScreenUpdating = False On Error Resume Next Set Rng = Range("C34:C38,C40:C44").SpecialCells(xlCellTypeBlanks).EntireRow On Error GoTo 0 If Not Rng Is Nothing Then Rng.Hidden = True 'Drucken If Not Rng Is Nothing Then Rng.Hidden = False End Sub

Hallo Rudi,
vielen Dank für die Antwort.
Ich habe das Problem erst auf den zweiten Blick gemerkt, und komme nicht weiter:
Das Problem mit der Zusatzzeile, wie im Ursprungsmakro:
For i = iRow To iRowL
If Cells(i, iCol) = 0 Then Rows(i).EntireRow.Hidden = True
If Cells(i, iCol) = 0 Then Rows(i + 1).EntireRow.Hidden = True
Next
Wenn die einzelnen Zeilen 34, 35, 36, 37, 38 leer (geprüft wird in Spalte C) sind, sollen die entsprechende Zeilen ausgeblendet werden.
Wenn, aber alle leer sind (34 bis 38) soll auch die Zeile 39 ausgeblendet werden, ist nämlich die Summe davon.
Das gleiche in Bereich der Zeilen 40 bis 44 wenn alle leer (geprüft wird in der Spalte C), dann soll auch die Zeile 45 ausgeblendet werden.
Vielen Dank. Grüße chandler

Sub print_n() Dim rng1 As Range, rng2 As Range Dim lngCol As Long, lngIndex As Long, lngStart As Long, lngEnd As Long lngCol = 3 lngStart = 34 '1. Bereich lngEnd = 38 For lngIndex = lngStart To lngEnd If Cells(lngIndex, lngCol) = 0 Then If rng1 Is Nothing Then Set rng1 = Rows(lngIndex) Else Set rng1 = Union(rng1, Rows(lngIndex).Resize(IIf(rng1.Rows.Count = 4 And lngIndex = lngEnd, 2, 1))) End If End If If Cells(lngIndex + 6, lngCol) = 0 Then If rng2 Is Nothing Then Set rng2 = Rows(lngIndex + 6) Else Set rng2 = Union(rng2, Rows(lngIndex + 6).Resize(IIf(rng2.Rows.Count = 4 And lngIndex = lngEnd, 2, 1))) End If End If Next If Not rng1 Is Nothing Then rng1.EntireRow.Hidden = True If Not rng2 Is Nothing Then rng2.EntireRow.Hidden = True 'Drucken Range(Cells(lngStart, 1), Cells(lngEnd + 7, 1)).EntireRow.Hidden = False End Sub

Beliebteste Forumthreads (12 Monate)

Leere Zeilen nicht drucken. Makro optimieren

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Leere Zeilen nicht drucken. Makro optimieren

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread