none
Zeilenhöhe per VBA anhand des Inhalts einer Zelle bestimmen - Geschwindigkeitsproblem RRS feed

  • Frage

  • Hallo,

    ich habe von einem Kunden eine Kalkulationstabelle zur Überarbeitung bekommen, und zwar geht es vor allem darum, die Zeilenhöhen automatisch anzupassen, d. h. wenn die Zelle in Spalte B mehr als 100 Zeichen enthält, soll die Zeilenhöhe auf 75 gesetzt werden, wenn sie mehr als 60 enthält, auf 50, wenn >0 dann 25, sonst 8.

    Ich habe das so realisiert:

        Set objSheet = Worksheets("Location eintr.")
       
        For X = 20 To 317
                    strZellenText(0) = Cells(X, intSpalte(0)).Value
                    intZellenLaenge(0) = Len(strZellenText(0))        
                    If intZellenLaenge(0) > 109 Then
                            Cells(3, X).VerticalAlignment = xlTop
                            Rows(X).RowHeight = 80
                        ElseIf intZellenLaenge(2) > 55 Then
                            Rows(X).RowHeight = 37
                        ElseIf intZellenLaenge(2) > 0 Then
                            Rows(X).RowHeight = 25
                        Else: Rows(X).RowHeight = 8
                    End If
                End If
        Next
       
    End Sub

    Funktioniert im Prinzip ziemlich gut - man muss noch berücksichtigen, dass Leerzellen zu behandeln sind, aber das ist nicht das Problem.

    Da fast 300 Zeilen einzeln überprüft werden müssen, läuft der Makro (der noch andere Dinge macht, aber ich glaube, hier ist die Bremse), minutenlang. Daher wüßte ich gern, ob jemand einen Tipp hat, wie man das Procedere beschleunigen kann. Danke schon mal!

    Susanne

    Dienstag, 26. April 2011 09:06

Antworten

  • Hallo Susanne,

    da in Deinem Beispielcode so einiges durcheinander geht, sich nicht mit der Beschreibung deckt und die Variablendeklaration fehlt, habe ich es so umgestrickt, dass es völlig unabhängig laufen kann:

        Dim i As Integer, rh As Integer
        Application.ScreenUpdating = False
        For i = 20 To 317
            Select Case Len(Cells(i, "B"))
                Case 0
                    rh = 8
                Case 1 To 60
                     rh = 25
                Case 61 To 100
                    rh = 50
                Case Else
                    rh = 75
            End Select
            If Rows(i).RowHeight <> rh Then Rows(i).RowHeight = rh
        Next i
        Application.ScreenUpdating = True

    Hang loose, Hartwig

    Mittwoch, 27. April 2011 14:11