Hallo Rickie,
mit VBA git es schon eine Möglichkeit.

Welche Zellen sind verbunden?



Gruß
fedjo

Hallo Fedjo

In meiner Tabelle sind sieben Zellen verbunden A - G

Würde mich freuen, wenn du mir eine entsprechende VBA-Anweisung hättest.

Gruss
Rickie

Hallo Rickie,
in das Codefenster der Tabelle wo die Zellenhöhe automatisch verändert werden soll:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("A1").Rows.AutoFit
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
If Range("A1").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

Bei der Aktiven Zelle (A1) wird dann der ganze Text angezeigt, ansonst nur die normale Zeilenhöhe.


Gruß
fedjo

Hallo Fedjo

Besten Dank für das feature - klappt tatsächlich.
Allerdings habe ich noch zwei Fragen dazu;

- im Moment bezieht sich das Makro nur auf eine Zelle.
Ich habe jedoch rund 2000 Zellen (Zeilen) die ich so ändern möchte. Gibt es dafür evtl einen Rangebefehl oder kann ich, da sich diese Zellen alle in der Spalte A befinden, die Spalte A als Range eingeben?
- zweitens passt sich die Zeile nur dann an den gefüllten Zelleninhalt an, wenn ich Sie aktiv (markiert) habe. Könnte man diese nicht konstant angepasst lassen?

Besten Dank im voraus für deine (eure) Mühe

Rickie

Hallo Rickie,
habe umgestellt auf Aktive Zelle, durch rechts Klick kann die Zelle zurückgesetzt werden.

Gruß
fedjo

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Selection.Rows.AutoFit
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target 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 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

Hi Fedji

Perfekt - genau das brauche ich!!!

Besten Dank für die Unterstützung

Rickie