Zeilenhöhe anpassen bei verbundenen Zellen

Grüezi lial

-Was ideal wäre: Wenn ich alle (verbundenen Zellen) dessen
höhe ich optimal haben möchte, markieren könnte und
anschliessend alle gleichzeitig so ansteuern könnte, dass sie
alle gleichzeitig die optimale Höhe annehmen.

Ok, das ist eine gute Beschreibung, die wir umsetzen können.

-was er mit dem jetzigen Code tut:
Wenn ich nur eine Zelle markiere und mit Alt+F8 den
gewünschten Marko (den von Dir angegebenen Code
(AutoFitMergedCellRowHeight)) aufrufe passt er mir die Grösse
der Zelle wunderbar dem Text an.

Wenn ich aber alle gewünschten Zellen markiere, und mit Alt+F8
den gewünschten Marko (den von Dir angegebenen Code
(AutoFitMergedCellRowHeight)) aufrufe dann trennt er mir die

  1. Zellenverbindung und passt die Grösse der obersten Zelle
    dem Text an. Verbinden tut er sie aber nicht mehr und die
    restlichen der markierten Zellen bleiben wie gehabt.

Ich hoffe Du kannst mir folgen!!!

Ja, bestens - der Code ist darauf ausgelegt eine einzelne Zelle zu bearbeiten. Wenn mehrere markiert sind, kann das schon schief gehen, weil es nicht explizit berücksichtigt wird.

Verwende daher den zweiten Code (mit der Prameter-Übergabe) und erstelle einen kleinen Hilfs-Code, der jede Zelle aus deiner Markierung ausliest und an diesen Code übergibt.
Damit hast Du dann deinen Wunsch oben abgedeckt.

Als Hilfs-Code kannst Du die folgenden Zeilen verwenden:

Sub Start()
Dim rngZelle As Range
 For Each rngZelle In Selection
 ZeilenHoeheVerbundeneZellen rngZelle
 Next rngZelle
End Sub

Damit kannst Du nun auch beliebige Zellen markieren (gemischt mit verbundenen und nicht verbundenen Zellen) und den Code rennen lassen.
Angepasst werden nur die verbundenen Zellen.

P.S. Dann bin ich wohl momentan etwas empfindlich.

Das kommt in den besten Familien vor, ich bin das auch immer mal wieder.

Hat vielleicht auch etwas damit zu tun dass ich schwanger bin.

Aber das ist doch eine freudige Ursache dafür - ich wünsche dir und deinem Baby alles Gute, viel Freude und gute Gesundheit.

Bitte entschuldige.

Ohne Einschränkung angenommen :smile:

Auch ich sage sorry, wenn ich etwas zu hart aufgetreten bin.

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -

Grüazi Thomas

-) Ich werde es gerne versuchen. Aber bitte hilf mir noch (hoffentlich) ein letztes Mal.

Wo muss ich denn jetzt die Codes eingeben?
-Diese Arbeitsmappe?
-Modul 1?
-Modul 2?

Und wie erstelle ich den eine Parameterübergabe?

Vielen Dank für Dein Verständnis und Deine Glückwünsche! Ich wünsche Dir natürlich auch viel Glück und Gesundheit!!!

LG Ilal

Grüezi Ilal

Grüazi Thomas

Das klingt putzig - etwa aus Bayern oder gar Österreich?

-) Ich werde es gerne versuchen. Aber bitte hilf mir noch (hoffentlich) ein letztes Mal.

Ich helf dir noch lange :smile:

Wo muss ich denn jetzt die Codes eingeben?
-Diese Arbeitsmappe?
-Modul 1?
-Modul 2?

Einfach in ein Modul - am besten beide/alle ins dasselbe Modul.

Und wie erstelle ich den eine Parameterübergabe?

Das ist bereits geschehen, nimm meine kleine Hilfs-Sub und den zweiten Code aus dem vorherigen Beitrag. Die Hilfs-Sub ruft dann die zweite mit dem richtigen Parameter (die Zelle die bearbeitet werden soll) korrekt auf (jedenfalls tat sie das in meinem Test).

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -

-) Nein, aus der Schweiz :smile: Du auch oder!!??

Du, bei mir funktioniert da was nicht.

Ich habs jetzt so eingefügt:

Sub AutoFitMergedCellRowHeight()
'passt die Zeilenhöhe bei verbundenen Zellen automatisch an
'von Hans Herber
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 = PossNewRowHeight
'.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub
Sub Start()
Dim rngZelle As Range
For Each rngZelle In Selection
ZeilenHoeheVerbundeneZellen rngZelle
Next rngZelle
End Sub

Und dann erhalte ich 2 Makros.
Wenn ich den 1. anwähle (AutoFitMergedCellRowHeight) dann sagt er mir „laufzeitfehler 1004“ und wenn ich dann debbugge markiert er mir diese Zeile gelb " .Cells(1).ColumnWidth = MergedCellRgWidth"

Wenn ich den 2. Makro anwähle (start) dann sagt er mir "Fehler beim kompilieren sub oder Funktion nicht definiert. Wahrscheinlich mache ich etwas falsch…

Dir werden meinetwegen noch graue Haare wachsen! :-/

Grüezi Ilal

-) Nein, aus der Schweiz :smile: Du auch oder!!??

Ja, klar - ich meinte halt wegen des ‚a‘ im Gruss :smile:

Du, bei mir funktioniert da was nicht.

Ich habs jetzt so eingefügt:

Sub AutoFitMergedCellRowHeight()

Ja, das ist das falsche Makro

Und dann erhalte ich 2 Makros.
Wenn ich den 1. anwähle (AutoFitMergedCellRowHeight) dann sagt
er mir „laufzeitfehler 1004“ und wenn ich dann debbugge
markiert er mir diese Zeile gelb " .Cells(1).ColumnWidth
= MergedCellRgWidth"

Wenn ich den 2. Makro anwähle (start) dann sagt er mir "Fehler
beim kompilieren sub oder Funktion nicht definiert.
Wahrscheinlich mache ich etwas falsch…

OK, ich wollt schon vorhin die Codes gemeinsam nennen, habe dann aber darauf verzichtet, keine Ahnung warum…

Erstelle ein neues Modul (und lösche die anderen, wenn dort sonst nichts drin ist ausser ‚unseren‘ Codes.
Nimm dann die folgenden Zeilen und kopiere sie in das neue Modul:

Sub tr\_Start()
Dim rngZelle As Range
 For Each rngZelle In Selection
 ZeilenHoeheVerbundeneZellen rngZelle
 Next rngZelle
End Sub




Sub ZeilenhoeheVerbundeneZellen(rngZelle As Range)
'passt die Zeilenhöhe bei verbundenen Zellen automatisch an
'von Hans Herber / angepasst von Thomas Ramel ([email protected])
'Aufrufen per Übergabeparameter mit der folgenden Zeile:
'
'Sub test()
'ZeilenhoeheVerbundeneZellen (ActiveSheet.Range("A1"))
'End Sub
'
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim CellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer

 If IsEmpty(rngZelle) Then
 Set rngZelle = ActiveCell
 End If

 If rngZelle.MergeCells Then
 With rngZelle.MergeArea
 If .Rows.Count = 1 And .WrapText = True Then
 Application.ScreenUpdating = False
 CurrentRowHeight = .RowHeight
 CellWidth = rngZelle.ColumnWidth
 For Each CurrCell In rngZelle.MergeArea
 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 = CellWidth
 .MergeCells = True
 .RowHeight = PossNewRowHeight
 End If
 End With
 End If
End Sub

Nun markiere deine Zellen im Tabellenblatt und lass die Sub ‚tr_Start‘ rennen.

Dir werden meinetwegen noch graue Haare wachsen! :-/

Keine Bange, die hab ich schon - wären wir Gorillas ging ich glatt als Graurücken durch… :wink:

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -

-) Da scheint dann wohl der Bündnerdialekt durch… :smile:

jupiiiiiiiiiiiiiiiiiii!!!
Du bist echt klasse!!! Es funktioniert!! Mann das war jetzt eine Zangengeburt!!

VIIIELEN LIEEBEN DANK!!!

Grüezi Ilal

-) Da scheint dann wohl der Bündnerdialekt durch… :smile:

…auch den mag ich gerne - ich war da über Jahre im Urlaub :smile:

jupiiiiiiiiiiiiiiiiiii!!!
Du bist echt klasse!!! Es funktioniert!!

Na feinstens, das freut mich doch sehr :smile:

Mann das war jetzt eine Zangengeburt!!

Am Ende ists dann ja so richtig ‚geflutscht‘ - ich hoffe, dass das in Zukunft bei dir/euch auch so geht und keine Zangengeburt wird.

Alles Gute also weiterhin…

VIIIELEN LIEEBEN DANK!!!

…und wirklich gern geschehen.

LG
Thomas Ramel

  • MVP für MS-Excel -

-) Das hoffe ich in der Tat auch! Man weiss es ja im Vornherein nie! Aber ich bin zuversichtlich und hoffe das beste!

Nur noch so aus Interesse! Hast Du die Codes eigentlich alle im Kopf oder gibt es da sowas wie nachschlagewerke??

Grüezi Ilal

Nur noch so aus Interesse! Hast Du die Codes eigentlich alle
im Kopf oder gibt es da sowas wie nachschlagewerke??

Mein Nachschlagewerk ist Google und die Excel-Foren.

Alles weitere ist Kreativität, Fleiss und ein Problem, das es zu lösen gilt. Ach ja, ein wenig Wissen um die Möglichkeiten, sowie die Objekte und Methoden von Excel-VBA gehört natürlich auch dazu.

LG
Thomas Ramel

Ist wirklich sehr intressant was man alles machen kann… Aber ich denke für meine Wenigkeit ist das zu kompliziert. Zum Glück gibt es ja Leute wie Dich…

Glg und ich wünsche Dir ein wunderschönes Wochenende!

Hallo ilal,

@Reinhard, vielen Dank für Deine Hilfe. Bei dem Code den Du
mir gegeben hast, werden alle Zeilenhöhen, der ganzen Tabelle
angepasst. Mit Ausnahme von den Sverweise. Die werden dann
gleich unsichtbar.
Funktioniert also auch nicht.

okay, ich hatte seinerzeit an deiner Beispielmappe getestet, da hat mein Code funktioniert.
Jetzt habe ich die Datei nicht mehr und anscheinend ist die Datei vom Hochladserver gelöscht worden.
Macht aber nix, dein Landsmann hat ja die Lösung gebastelt.

@Thomas, ja es geht hier um Optik, da hast Du wohl recht. Ich
würde ja schon die Originaltabelle zur Verfügung stellen. Aber
das Problem dabei ist, dass es sich dabei um eine Datei
handelt, die dem Geschäft gehört, für das ich arbeite. Es hat
vertrauliche Preise drauf usw. Ich dachte es ginge hier ums
Prinzip.

Thomas hat ja schon erklärt. Natürlich könnte er, ich, andere, dir eine Lösung basteln wo das prinzip erkennbar ist wie man da vorgehen könnte.
Nur, das sagen unsere Erfahrungen, gibt es da sehr oft gewaltige Umsetzungsprobleme der Anfrager dies an ihre Originalmappe anzupassen.

Deshalb ist uns eine Beispielmappe wichtig, die genau die relevante Struktur/Aufbau wie das Original hat.
In deinem Fall also, auch viel Text in den verbundenen Zellenbereichen.
Wegen Datenschutz ist es für dich schon notwendig, ggfs. den Text zu anonymisieren.

Dies wäre dann so ein anonymisierter Text:

rgöklagjfdkg gkfjkflg ögjfgf ökjgöfg sjöaaka gapiurp0 gnhc
dfhjdfhfd fshs gjsögj gkägs 866l4 35frlf9 ffglfko gkflfklfk

Bei Spalten mit Preisen, fügste oben ein
=zuallszahl()*100
Kopierst das nach unten, dann markierst du die Spalte, Strg+c, Bearbeiten–Inhalte einfügen–Werte.

Evtl. Spalten mit Anzahl o.ä. können so bleiben.

namenslisten, Artikellisten, die geschützt werden müssen weil sie Informationen bieten, da schreibst du in die obere Zelle
Namen1 bzw. Artikel1
dann gehst du wieder auf die Zelle, dort auf die rechte untere Ecke bis der Mauszeiger zum kleinen Kreuz wird und ziehst das nach unten.
Excel macht dann sowas daraus:

Namen1
Namen2
Namen3
usw.

Auch wichtig. Außer in speziellen Sonderfällen, brauchen wir auch keine 5000 Datensätze, 10-30 reichen dicke.

Alle sonstigen Blätter die für das Problem uninteressant sind, kannste auch löschen.

In der Zeit wo ich das hier schreibe hätte ich deine Tabelle wie beschrieben auch anonymisiert.

Und, wenn du das paarmal geübt hast, bist dann genau so schnell.
Also trainiere das bitte.

Den ewinn/Erfolg kassierst du, wenn du wieder irgendwo eine Excelfrage stellst und eine derartige Beispielmappe mit hochladen kannst.
Dann haben die Helfer die Chance, dir maßgeschneiderte Lösungen aufzuzeigen oder dir sie sogar in die Mappe einzubauen und ihrerseits die mappe hochzuladen.

Einen Nachteil hat das ganze Prozedre, wenn du dich nicht selbst auf den Hosenboden setzt und die Lösungen Step by Step überprüfst und lernen willst wie, warum, wozu da etwas so gemacht wurde, sondern einfach nur übernimmst, dann lernst du Null und bist uaf ewig völlig abhängig von Fremden.

Lese dazu bitte hier. was Peter dazu schrieb.

Übrigens zum Lernen, durch eine Tabelle kam ich überhaupt zu Excel.
In einem Chat haben wir Abends immer gequizt. Einer hat Fragen gestellt, wie bei Formel1 gabs dann untersch. Punktefür die schnellsten Antworten.
Ein anderer hat die Punkte für die anderen mitnotiert, unser „Wärter“ :smile:
Wei wir uns abwechselten wer diesen Job machte, bekam jeder eine Excelmappe, die mal einer aus diesem Chat genau für das Quiz gebastelt hatte.
Das war das erst Mal, daß ich überhaupt eine Excelmappe sah. An dieser Mappe habe ich begonnen zu lernen, ohne Buch, Kurs.
Erst nach einigen Monaten stieß ich auf das Wort „Vba“…

Ich muß zugeben, dieser Weg ist hart, steinig und garantiert nicht der schnellste, schon oftmals den Gedanken gehabt, viel zu kompliziert, das lernst du nie.

Und, alles Gute daß die Geburt gut läuft. Wenn dann bei dir die Glückshormone wieder die Oberhand gewonnen haben weil dich da so ein verknitterte Würmchen anlächelt, naja meist brüllend die Augen zu hat *lächel* dann lese dies Beitragsfolge nochmals, garantiert wirst du dann den Kopf schütteln, daß du den pösen pösen Thomas in Richtung Unmensch geschubst hast.
Ich hatte sehr sehr gestaunt als ich das las *hihi*

Aber das ist Vergangenheit, möge es da bleiben.
Und, das sieht sehr danach aus wenn ich den weiteren Gesprächsverlauf anschaue *freu*

Gruß
Reinhard