ich habe hier auf den Herber Seiten ein Script zum Optimieren der Zeilenhöhe von gebunden Zellen gefunden. Das Script läuft soweit. Jedoch benötigt es für die Änderung von etwa 30 Zellen eine Laufzeit von etwa 5 Minuten...
Kann das richtig sein?
bei "Range("AJ68:AT68").Select" handelt es sich zum Beispiel um eine verbunden Zelle.
hier mein Code, kann man diesen irgendwie schneller machen?
Sub Zeilenhöhe_gebundene_Zellen_anpassen()
'Aktualisierung des Bildschirms ausschalten
Application.ScreenUpdating = False
'zuerst Standard wieder herstellen
Rows("68:77").RowHeight = 12.75
Rows("82:91").RowHeight = 12.75
'Bereich 1
Range("AJ68:AT68").Select
Call AutoFitMergedCellRowHeight
Range("AJ69:AT69").Select
Call AutoFitMergedCellRowHeight
Range("AJ70:AT70").Select
Call AutoFitMergedCellRowHeight
Range("AJ71:AT71").Select
Call AutoFitMergedCellRowHeight
Range("AJ72:AT72").Select
Call AutoFitMergedCellRowHeight
Range("AJ73:AT73").Select
Call AutoFitMergedCellRowHeight
Range("AJ74:AT74").Select
Call AutoFitMergedCellRowHeight
Range("AJ75:AT75").Select
Call AutoFitMergedCellRowHeight
Range("AJ76:AT76").Select
Call AutoFitMergedCellRowHeight
Range("AJ77:AT77").Select
Call AutoFitMergedCellRowHeight
'Bereich 2
Range("AX68:BI68").Select
Call AutoFitMergedCellRowHeight
Range("AX69:BI69").Select
Call AutoFitMergedCellRowHeight
Range("AX70:BI70").Select
Call AutoFitMergedCellRowHeight
Range("AX71:BI71").Select
Call AutoFitMergedCellRowHeight
Range("AX72:BI72").Select
Call AutoFitMergedCellRowHeight
Range("AX73:BI73").Select
Call AutoFitMergedCellRowHeight
Range("AX74:BI74").Select
Call AutoFitMergedCellRowHeight
Range("AX75:BI75").Select
Call AutoFitMergedCellRowHeight
Range("AX76:BI76").Select
Call AutoFitMergedCellRowHeight
Range("AX77:BI77").Select
Call AutoFitMergedCellRowHeight
'Bereich 3
Range("AL82:AZ82").Select
Call AutoFitMergedCellRowHeight
Range("AL83:AZ83").Select
Call AutoFitMergedCellRowHeight
Range("AL84:AZ84").Select
Call AutoFitMergedCellRowHeight
Range("AL85:AZ85").Select
Call AutoFitMergedCellRowHeight
Range("AL86:AZ86").Select
Call AutoFitMergedCellRowHeight
Range("AL87:AZ87").Select
Call AutoFitMergedCellRowHeight
Range("AL88:AZ88").Select
Call AutoFitMergedCellRowHeight
Range("AL89:AZ89").Select
Call AutoFitMergedCellRowHeight
Range("AL90:AZ90").Select
Call AutoFitMergedCellRowHeight
Range("AL91:AZ91").Select
Call AutoFitMergedCellRowHeight
Application.ScreenUpdating = True
End Sub
'Zeilenumbruch von gebundenen Zellen
Sub AutoFitMergedCellRowHeight()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
iX = iX + 1
Next
MergedCellRgWidth = MergedCellRgWidth + (iX - 1) * 0.71
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub