Geschwindigkeitsprobleme

[spisst]

Hallo,

hoffentlich kann mir einer von euch helfen mein Problem zu lösen:

Ich habe eine Excel-Tabelle bei der inerhalb gewisser Zeilenblöcke kein Seitenumbruch beim Ausdrucken erfolgen darf.

Mein Lösungsweg:

Durchlaufe alle Zeilen bis zum ersten automatischen Seitenumbruch
überprüfen ob er an dieser Stelle sein darf
wenn nicht gehe wieder nach oben bis zur ersten Zeile an der er sein darf
setze manuellen Umbruch und laufe wieder bis zum nächsten automatischen Umbruch

'Alle Seitenumbrüche löschen
    ActiveSheet.ResetAllPageBreaks

    'Finden der Seitenumbrüche und durch Korrekte ersetzen
    For i = 8 To LetzteZeile
        If Worksheets("Entscheidungsmatrix").Rows(i).PageBreak = xlPageBreakAutomatic Then
            If (Not (Worksheets("Entscheidungsmatrix").Range("AB" & i).Value = 1)) Then
                'Wenn Zeilenumbruch gefunden nach oben bis zur ersten Erlaubten Umbruchszeile gehen (Markiert durch Wert 1 in Spalte AB
               Do Until (Worksheets("Entscheidungsmatrix").Range("AB" & i).Value = 1)
                    i = i - 1
                    If i < 2 Then 'falls i kleiner 2 wird abbrechen
                        Exit Do
                    End If
                Loop
            End If
            
            'Setzen des manuellen Umbruchs
            Worksheets("Entscheidungsmatrix").Rows(i).PageBreak = xlPageBreakManual
               
        End If
        
      
    
    
    Next

Das funktioniert soweit auch gut, leider nur sehr langsam.
Kennt wer eine Methode, bei der ich nicht die beiden Schleifen abarbeiten muss?


mfg


Thomas

[tAgedObject]

Auflistung v/hPageBreaks...?

Hallo,

Ohne das jetzt geprüft zu haben :
Das WorkSheet hat doch eine Auflistung für vertikale und horizontale Seitenumbrüche. Vielleicht kannst Du besser gleich durch diese iterieren...?

Grüße,
tAgedObject

[spisst]

Hallo,

danke für den Tipp habs nun so gelöst
und es ist erheblich schneller

'Alle Seitenumbrüche löschen
    Worksheets("Entscheidungsmatrix").ResetAllPageBreaks

    'Finden der Seitenumbrüche und durch Korrekte ersetzen
    j = 1
    For j = 1 To Worksheets("Entscheidungsmatrix").HPageBreaks.Count
        Reihe = Worksheets("Entscheidungsmatrix").HPageBreaks(j).Location.Row
        If (Not (Worksheets("Entscheidungsmatrix").Range("AB" & Reihe).Value = 1)) Then
            'Wenn inkorrekter Zeilenumbruch gefunden nach oben bis zur ersten Erlaubten Umbruchszeile gehen
            Do Until (Worksheets("Entscheidungsmatrix").Range("AB" & Reihe).Value = 1) And (Worksheets("Entscheidungsmatrix").Rows(Reihe).Hidden = 0)
                Reihe = Reihe - 1
                If Reihe < 2 Then 'falls i kleiner 2 wird abbrechen
                    Exit Do
                End If
            Loop
        End If
    
            'Setzen des manuellen Umbruchs
            Worksheets("Entscheidungsmatrix").Rows(Reihe).PageBreak = xlPageBreakManual
   Next