AW: VBA: Optimale Breite eines Bereiches
09.12.2012 12:08:23
schauan
Hallo zusammen,
vielleicht kann man auch beide Lösungen kombinieren...
Sub AutoFitZellen()
'Makro zur Festlegung der optimalen Spaltenbreite anhand eines
'definierten Bereiches mit Hilfe eines temporaeren Blattes
'Hinweis:
'ggf. vorher calculation, events, alerts und screenupdating ruecksetzen!
'Variablendeklarationen
'Range
Dim rng As Range, rngCol As Range, rngTmp As Range
'Worksheet
Dim objTab As Worksheet
'String-Konstante (Name vom Originalblatt)
Const strOrig As String = "Tabelle1"
'Originalblatt ans Ende kopieren
Sheets(strOrig).Copy After:=Sheets(Sheets.Count)
'Tabellenblatt dem Objekt zuweisen
Set objTab = Sheets(Sheets.Count)
'zu bearbeitenden Bereich festlegen
Set rng = objTab.Range("D120:H500,K120:M500,Z120:Z500")
'Schleife ueber jede Spalte im rng
For Each rngCol In rng.Columns
'Mit dem Rng
With rngCol
'Bereich ueber dem rng festlegen -
'Optimierungsbedarf: Pruefen, ob da auch was drueber ist
Set rngTmp = objTab.Range(objTab.Cells(1, .Column), .Cells(1, 1).Offset(-1, 0))
'Bereich unter dem rng festlegen -
'Optimierungsbedarf: Pruefen, ob da auch was drunter ist
Set rngTmp = Union(objTab.Range(.Cells(.Rows.Count, 1).Offset(1, 0), objTab.Cells(objTab.Rows.Count, .Column)), rngTmp)
'Format "nix anzeigen" setzen
rngTmp.NumberFormat = ";;;"
'Spaltenbreite automatisch optimieren
rngTmp.EntireColumn.AutoFit
'Spaltenbreite auf Originalblatt uebertragen
Sheets(strOrig).Columns(.Column).ColumnWidth = objTab.Columns(.Column).ColumnWidth
'End With
'Ende Mit dem Rng
End With
'Ende Schleife ueber jede Spalte im rng
Next
'Blattobjekt zuruecksetzen
Set objTab = Nothing
'Meldungen ausschalten
Application.DisplayAlerts = False
'temporaeres Blatt loeschen
Sheets(Sheets.Count).Delete
'Meldungen einschalten - waren die denn vorher ein?
Application.DisplayAlerts = True
End Sub
Hoffe geholfen zu haben
Grüße von André aus G in T (xls 97-2013)