Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

zeilenhöhe verbundenen Zellen von Zeile 1 bis 500

Forumthread: zeilenhöhe verbundenen Zellen von Zeile 1 bis 500

zeilenhöhe verbundenen Zellen von Zeile 1 bis 500
10.09.2015 15:39:15
Zeile
Hallo Excel Gemeinde,
als erstes muss ich meinen großen Dank für Foren wie dieses aussprechen. Als bis dato passiver Leser der Beiträge konnte ich durch stümperhaftes zusammen schreiben eurer Codes jedes Problem lösen.
In einer Excel-Liste möchte ich nun, dass sich die Zeilenhöhe der verbundenen Zellen
automatisch an den Text anpasst. Nach intensiver Internetrecherche bin ich auch in diesem Forum _
auf folgenden Code gestoßen, der auch super funktioniert:

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 + 10
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Range("A1").Select
End Sub

Allerdings wird nur die gerade angewählte Zelle angepasst. Ich möchte dagegen, dass dieser Code für jede Zelle B "i" von i = 1 bis 500 durchläuft.
Meine amateurhaften Versuche das ganze einfach in eine For Schleife zu pressen haben natürlich nicht funktioniert.
Vielen Dank schonmal im Voraus!!

Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Schleife einfügen
10.09.2015 16:03:36
Daniel
Hi
Sub AutoFitMergedCellRowHeight()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
Dim Zelle as Range
For Each Zelle in Range("B1:B500").Cells
If Zelle.MergeCells Then
With Zelle.MergeArea
hier dann der weitere Code 1:1
ggf jedes "ActiveCell" durch "Zelle" tauschen
end with
end If
Next Zelle
End Sub
gruß Daniel

Anzeige
zeilenhöhe verbundenen Zellen
10.09.2015 16:05:04
Rudi
hallo,
teste mal:
Sub AutoFitMergedCellRowHeight()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer, lRow As Long
For lRow = 1 To 500
If Cells(lRow, 2).MergeCells Then
With Cells(lRow, 2).MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = Cells(lRow, 2).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 + 10
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Next lRow
Range("A1").Select
End Sub
Gruß
Rudi

Anzeige
AW: zeilenhöhe verbundenen Zellen
10.09.2015 16:48:41
Marcel
Zunächst vielen Dank an die schnellen Antworten!!
Mir kam dann doch noch ein EIGENER Einfall (stolz ;)).
Ich habe einfach ein zweites Makro geschrieben, dass das besagte Makro 500 mal ausführt:
Sub zeilenhoehemitmakro()
For i = 1 To 100
Range("B" & i).Activate
Call AutoFitMergedCellRowHeight
Range("E" & i).Activate
Call AutoFitMergedCellRowHeight
Next
End Sub

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 + 10
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub
Ich bin mir ziemlich sicher, dass eure Lösungen deutlich besser sind, aber mit meinen Makros agiere ich wie mit einem alten Auto: Solange es funktioniert lieber nicht rumfummeln.
LG

Anzeige
AW: zeilenhöhe verbundenen Zellen
10.09.2015 17:11:08
Daniel
Hi
im Prinzp ne Super Idde.
die lässt sich aber noch deutlich verbessen, wenn du nicht mit der Aktiven Zelle arbeitest, sondern die Zelle, die bearbeitet werden soll, direkt ansprichst, ohne sie zu aktiveren.
damit dein Autofit-Makro funtkioniert, machst du ne Variablenübergabe:
Sub zeilenhoehemitmakro()
For i = 1 To 100
Call AutoFitMergedCellRowHeight(Cells(i, 2))
Call AutoFitMergedCellRowHeight(Cells(i, 2))
Next
End Sub

Sub AutoFitMergedCellRowHeight(Zelle as Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
If Zelle.MergeCells Then
With Zelle.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 + 10
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub
Vorteil: Code wird kürzer, schneller und der Bildschirm zappelt nicht.
Gruß Daniel
Anzeige
;
Anzeige
Anzeige

Infobox / Tutorial

Automatische Zeilenhöhe für verbundene Zellen in Excel anpassen


Schritt-für-Schritt-Anleitung

Um die Zeilenhöhe für verbundene Zellen in Excel automatisch anzupassen, kannst du folgenden VBA-Code verwenden. Dieser Code durchläuft die Zellen in der Spalte B von Zeile 1 bis 500 und passt die Zeilenhöhe entsprechend dem Text an.

  1. Öffne Excel und drücke ALT + F11, um den VBA-Editor zu öffnen.
  2. Klicke auf Einfügen > Modul, um ein neues Modul zu erstellen.
  3. Füge den folgenden Code ein:
Sub AutoFitMergedCellRowHeight()
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    Dim iX As Integer, lRow As Long

    For lRow = 1 To 500
        If Cells(lRow, 2).MergeCells Then
            With Cells(lRow, 2).MergeArea
                If .Rows.Count = 1 And .WrapText = True Then
                    Application.ScreenUpdating = False
                    CurrentRowHeight = .RowHeight
                    ActiveCellWidth = Cells(lRow, 2).ColumnWidth
                    MergedCellRgWidth = 0

                    For Each CurrCell In .Cells
                        MergedCellRgWidth = MergedCellRgWidth + CurrCell.ColumnWidth
                        iX = iX + 1
                    Next

                    MergedCellRgWidth = MergedCellRgWidth + (iX - 1) * 0.71
                    .MergeCells = False
                    .Cells(1).ColumnWidth = MergedCellRgWidth
                    .EntireRow.AutoFit
                    PossNewRowHeight = .RowHeight + 10
                    .Cells(1).ColumnWidth = ActiveCellWidth
                    .MergeCells = True
                    .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
                End If
            End With
        End If
    Next lRow
    Range("A1").Select
End Sub
  1. Schließe den VBA-Editor und kehre zu Excel zurück.
  2. Führe das Makro über Entwicklertools > Makros aus.

Häufige Fehler und Lösungen

  • Fehler: Das Makro funktioniert nicht wie erwartet.

    • Lösung: Stelle sicher, dass die Zellen in der Spalte B tatsächlich verbunden sind und dass die Option "Zeilenumbruch" aktiviert ist.
  • Fehler: Die Zeilenhöhe wird nicht korrekt angepasst.

    • Lösung: Überprüfe, ob der Code in einer neuen Moduldatei eingefügt wurde und nicht in einem bestehenden Makro. Dies könnte zu Konflikten führen.

Alternative Methoden

Eine Alternative zum oben genannten Makro wäre, ein einfaches Makro zu schreiben, das die Zeilenhöhe für mehrere Zellen hintereinander anpasst, ohne jede Zelle zu aktivieren:

Sub zeilenhoehemitmakro()
    Dim i As Integer
    For i = 1 To 500
        Call AutoFitMergedCellRowHeight(Cells(i, 2))
    Next i
End Sub

Diese Methode nutzt eine Variablenübergabe und kann die Leistung verbessern, da der Bildschirm nicht flackert.


Praktische Beispiele

  • Beispiel 1: Wenn du in Zelle B1 den Text "Das ist ein Beispieltext" hast und diese Zelle mit B2 verbunden ist, wird das Makro die Zeilenhöhe automatisch anpassen, sodass der gesamte Text sichtbar bleibt.

  • Beispiel 2: Wenn du mehrere Zellen in der Spalte B mit unterschiedlichen Textlängen hast, wird das Makro alle verbundenen Zellen in diesem Bereich berücksichtigen und die Zeilenhöhe entsprechend anpassen.


Tipps für Profis

  • Nutze die Option "ScreenUpdating" im VBA-Code, um die Geschwindigkeit des Makros zu erhöhen und ein Flackern des Bildschirms zu vermeiden.
  • Arbeite immer mit einer Sicherungskopie deiner Excel-Datei, bevor du Makros ausführst.
  • Experimentiere mit den Anpassungen des Codes, um ihn an deine speziellen Bedürfnisse anzupassen.

FAQ: Häufige Fragen

1. Kann ich das Makro für eine andere Spalte verwenden?
Ja, ändere einfach die Spaltenreferenz im Code von Cells(lRow, 2) zu der gewünschten Spalte.

2. Was passiert, wenn ich mehr als 500 Zeilen habe?
Du kannst die Zahl 500 im Code auf die benötigte Anzahl an Zeilen anpassen, um mehr Zellen zu berücksichtigen.

3. Funktioniert dieser Code auch in Excel Online?
Der VBA-Code funktioniert nur in der Desktop-Version von Excel. In Excel Online sind Makros nicht unterstützt.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige