PDA

Vollständige Version anzeigen : automatische Zeilenhöhe erhöhen


thomme1
26.06.2014, 12:19
An die Excelspezialisten

Habe folgendes Problem:
Ich möchte per VBA zur automatischen Zeilenhöhenermittlung noch einen zusätzlichen Abstand (Durchlass) zur jeweils ermittelten Zeilenhöhe dazu gerechnet wird.
Ich habe bis jetzt folgenden Code.

Sub ZeilenhoeheAnpassen()
Range("1:1000").Rows.EntireRow.AutoFit
With Rows("1:1000").EntireRow
.AutoFit
.RowHeight = .RowHeight + 5
End With
End Sub


Das funktioniert so aber noch nicht.
Ändere ich „with Rows(„4:4“).EntireRow, macht er mir nur die Zeile 4 grösser.
Kann mir da jemand helfen?

Mc Santa
26.06.2014, 12:49
Hallo,

so geht es, aber dauert bei 1000 Zeilen ein paar Sekunden:
Dim rng As Range
Range(Cells(1, 1), Cells(30, 1)).EntireRow.AutoFit
For Each rng In Range(Cells(1, 1), Cells(30, 1))
rng.RowHeight = rng.RowHeight + 5
Next rng
End Sub

Du musst leider jede Zeile seperat anpassen, da die Höhe ja nicht einheitlich ist.

Hilft dir das weiter?
VG

chris-kaiser
26.06.2014, 12:55
Hallo Thomas,

[edit] da lag ich falsch..

thomme1
26.06.2014, 13:40
Hallo MC Santa

Besten Dank, hast mir geholfen.
Es dauert wirklich lange, deshalb meine Frage:
Kann ich die Abfrage auf eine Spalte (16) beschränken?

Mc Santa
26.06.2014, 13:43
Hallo,

auf welche Spalte sich der Code bezieht, ist egal, denn die Zeilenhöhe für eine bestimmte Zeile ist in jeder Spalte gleich ;)

Haben die Zeilen hinterher alle die gleiche Höhe, oder ist das unterschiedlich?

VG

thomme1
26.06.2014, 13:55
Nein, es soll schon jede Zeile dieselbe Höhe haben.
Ich meinte nur dass es schneller geht wenn er nur in der Spalte suchen muss in der ich als Format einen Zeilenumbruch möglich mache. Also Spalte 16.
Eine schneller Lösung gibt es nicht? Bei 1000 Datenzeilen dauert es doch ziemlich lange.

Mc Santa
26.06.2014, 14:15
Wie gesagt, die Spalte ist egal.

Die Frage ist für mich, ob nach .AutoFit alle Zeilen (1-1000) die gleiche Zeilenhöhe haben, etwa 34. Oder ob das immer unterschiedlich ist.

VG

thomme1
26.06.2014, 14:24
Nein, es kann jede Zeile eine andere Höhe haben.
Eben automatische Zeilenhöhe +5 und das bei jeder Zeile!

Mc Santa
26.06.2014, 14:33
Hallo,

ok, dann bleibt es leider bei der langsamen Laufzeit. Zumindest habe ich keine Idee mehr wie man das schneller machen kann, denn ich muss ja die Zeilenhöhe für jede Zeile seperat einstellen.

VG

mücke
26.06.2014, 14:34
Moin Thomas,

nur mal so aus Neugierde, was stimmt denn jetzt?
#8 ... Nein, es kann jede Zeile eine andere Höhe haben
#6 ... Nein, es soll schon jede Zeile dieselbe Höhe haben

thomme1
26.06.2014, 15:16
Hoi Mücke

#6 bezieht sich auf Antwort aus #5 und da ging es meiner Ansicht um Zelle.

Richtig ist, dass nicht jede Zeile in der Tabelle die gleiche Höhe haben muss!

Den Code den ich hier gepostet habe ist viel schneller, nur das er mir eben die Erweiterung um 5pt nicht macht.
Und dieses ist unumgänglich, weil ansonsten die Zeilen zu nahe aufeinander stehen.
Vielleicht kann mir ja doch noch jemand helfen.

Mc Santa
26.06.2014, 15:21
Hallo,

gib mir mal deine Beispieldatei, mit ein paar Datensätzen (~200) mit denen ich rumspielen kann, vielleicht fällt mir dann noch etwas gutes ein :)

VG

RPP63neu
27.06.2014, 07:00
Hallo!
Bei mir dauert es 0,07 Sekunden ... :cool:
1. Ich fülle erst einmal ein paar Zeilen, damit ich unterschiedliche Zeilenhöhen erzwinge:
Sub füllen()
Dim Zeile As Long, Dummy As String
Dummy = "Dies ist" & Chr(10) & "ein" & Chr(10) & "Dummy-Text"
Application.ScreenUpdating = False
For Zeile = 1 To 1000 Step 3
Cells(Zeile, 1).Value = Dummy
Next
Application.ScreenUpdating = True
End Sub
McSantas Code ergänzt mit ScreenUpdating:
Sub ZeilenHöhe()
Dim rng As Range
Dim Start As Double
Start = Timer
Application.ScreenUpdating = False
Range(Cells(1, 1), Cells(1000, 1)).EntireRow.AutoFit
For Each rng In Range(Cells(1, 1), Cells(30, 1))
rng.RowHeight = rng.RowHeight + 5
Next rng
Application.ScreenUpdating = True
MsgBox "Dauer: " & Timer - Start & " sec."
End Sub
Gruß, Ralf

chris-kaiser
27.06.2014, 07:41
Hi,

Option Explicit
Sub row2max()
Application.ScreenUpdating = False
Rows.AutoFit
Dim lngLastR As Long, i As Long, Max As Double
lngLastR = Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To lngLastR
If Rows(i).Height > Max Then Max = Rows(i).Height
Next
Rows("1:" & lngLastR).RowHeight = Max
End Sub

Mc Santa
27.06.2014, 07:54
Hallo,

ich habe noch einmal eine neue Vermutung, warum der Code bei dir langsam sein könnte: Möglicherweise hast du viele Volatile Funktionen (Indirekt, Bereich.verschieben, ...) und es hilft dir, beim Makro die Berechnung auszuschalten.
Etwa so:
Code von RPP63neu, von mir modifiziertOption Explicit

Sub ZeilenHöhe()
Dim rng As Range
Dim Start As Double
Start = Timer
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Range(Cells(1, 1), Cells(1000, 1)).EntireRow.AutoFit
For Each rng In Range(Cells(1, 1), Cells(30, 1))
rng.RowHeight = rng.RowHeight + 5
Next rng

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Dauer: " & Timer - Start & " sec."
End Sub

Hilft dir das?
VG

thomme1
29.06.2014, 18:49
Besten Dank für Eure Beiträge.
Ich habe zuhause am Freitag meinen Code noch wie anschliessend geändert. Und jetzt läuft es genau wie ich mir das vorgestellt habe und auch schnell.

Sub ZeilenhoeheAnpassen()
Application.ScreenUpdating = False
Dim rng As Range
Range("5:5003").Rows.EntireRow.AutoFit
For Each rng In Range(Cells(6, 1), Cells(5003, 1))
rng.RowHeight = rng.RowHeight + 5
Next rng
Application.ScreenUpdating = True
End Sub

Nur ist der Code noch mit absoluten Zeilenwerten versehen (5003).
Wie kann ich ihn anpassen dass er in Spalte A immer bis zur letzten Zeile sucht die einen Wert beinhaltet (KEINE Formeln).

Mc Santa
29.06.2014, 19:30
Hallo,

Ein Wert ist etwas, dass du in die Zelle schreibst ohne = (Istgleich). Eine Formel ist etwas mit = (Istgleich)
Ist es also richtig, dass du erst Werte und dann Formeln hast? Oder hast du immer Formeln und am Ende ergeben deine Formeln "" (leerer Text) wodurch nichts angezeigt wird?

Das ist für das Makro wichtig. Daher möglichst genau beschreiben.
Immer noch hilft eine Beispieldatei, denn dort werden für uns Helfer so viele wichtige Fragen beantwortet, die sehr häufig als nebensächlich empfunden werden.
VG

thomme1
29.06.2014, 20:49
Ich lade hier mal die Datei hoch.
Es geht um die Tabelle sägen, welche via Formeln die Werte von Tabelle Bestellungen übernimmt.

Mc Santa
29.06.2014, 21:50
Hallo,

ich habe folgenden Vorschlag, allerdings treffe ich dazu ein paar Annahmen:
Sub ZeilenhoeheAnpassen()
Application.ScreenUpdating = False
Dim rng As Range, bereich As Range
Set bereich = Range(Cells(5, 1), Cells(7, 1).End(xlDown)).SpecialCells(xlCellTypeFormulas, 1)
bereich.EntireRow.AutoFit
For Each rng In bereich
rng.RowHeight = rng.RowHeight + 5
Next rng
Application.ScreenUpdating = True
End Sub

Der Code markiert alle Zahlen in Spalte A die aus einer Formel resultieren. Eine leere Zelle ist für Excel ein Text. Wichtig ist aber dadurch, dass deine RefNr tatsächlich eine Zahl ist und nicht als Text formatiert. In deiner Beispieltabelle ist das der Fall.

Hilft dir das weiter? Fragen gerne :)
Gruß
Mc Santa

thomme1
29.06.2014, 22:11
Besten Dank
Ich habe oben im gelben Feld noch Infos erwähnt die Du vielleicht übersehen hast.
Habe Deinen Code getestet, funktioniert auch bis zur ersten leeren Zelle in Spalte A. Da endet der Code und übersieht die in Zeilen ~1000.

Mc Santa
29.06.2014, 23:03
Hm ok,

probiere es noch einmal folgendermaßen, dürfte nur geringfügig langsamer sein:
Sub ZeilenhoeheAnpassen()
Application.ScreenUpdating = False
Dim rng As Range, bereich As Range
Set bereich = Range(Cells(5, 16), Cells(Rows.Count, 16).End(up))
bereich.EntireRow.AutoFit
For Each rng In bereich
If Not rng.Value = "" Then rng.RowHeight = rng.RowHeight + 5
Next rng
Application.ScreenUpdating = True
End Sub

thomme1
30.06.2014, 05:24
Besten Dank
Musste noch bei .End (up) ändern in .End(xlUp)
Jetzt funktioniert es.
Danke für Deine Hilfe.