Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1476to1480
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Automatische Zellenhöhe bei verbunden Zellen

Automatische Zellenhöhe bei verbunden Zellen
01.03.2016 12:42:59
Tom
Hallo,
ich möchte über das ganze Tabellenblatt die verbundenen Zeilen automatisch in der Höhe anpassen lassen. Dazu habe ich folgenden Code hier im Forum gefunden. Wie muss der Code umgeschrieben werden damit ich alle Zeilen damit anspreche?
arrZ = Array(13, 20, 28, 15)

Gruß Tom
------------------------------
in ein normales Modul:
Option Explicit
'   nach: www.herber.de/mailing/137101h.htm
'   "Zeilenhöhe bei verbundenen Zellen anpassen"
Sub ZeilenhoeheVerbundene(lngZeileNr As Long)
'  Parameter ist die Zeilennummer.
'  In einer Zeile kann es mehrere verbundene Zellen geben.
Dim sngHoehe As Single, cc As Integer, rngC As Range
Dim sngActWid As Single, rngM As Range, sngMergWid As Single
Application.ScreenUpdating = False
With Rows(lngZeileNr)
.AutoFit
sngHoehe = .RowHeight    ' Mindesthöhe (insbes. nicht-verbundene Zellen)
End With
For cc = 1 To Cells(lngZeileNr, Columns.Count).End(xlToLeft).Column
If Cells(lngZeileNr, cc) > "" And Cells(lngZeileNr, cc).MergeCells Then
Set rngC = Cells(lngZeileNr, cc)
If Len(rngC) > 1000 Then
MsgBox "Der Text in " & rngC.Address(0, 0) & " hat über 1000 Zeichen !" _
& vbLf & vbLf & "Bitte kürzen!", vbCritical, "ZeilenhoeheVerbundene"
rngC.Select
Exit Sub
End If
With rngC.MergeArea
If .Cells(1).Address = rngC.Address And .WrapText = True Then
sngActWid = rngC.ColumnWidth      ' Merken zum Wiederherstellen
' ---------------------------------------- Gesamtbreite rechnen
For Each rngM In .Cells
sngMergWid = rngM.ColumnWidth + sngMergWid
Next
sngMergWid = sngMergWid + (.Count - 1) * 0.71
' ----------------- Merge aufheben, Zellbreite auf Gesamtbreite
.MergeCells = False
rngC.ColumnWidth = sngMergWid
' ---------------------------------- max. optim. Höhe ermitteln
.EntireRow.AutoFit
sngHoehe = Application.Max(sngHoehe, rngC.Height)
' --------------------------- Breite und Merge wiederherstellen
rngC.ColumnWidth = sngActWid
.MergeCells = True
End If
End With
End If
Next cc
Rows(lngZeileNr).RowHeight = sngHoehe         ' max. optim. Höhe einstellen
Application.ScreenUpdating = True
End Sub
Sub tst()
ZeilenhoeheVerbundene 20
End Sub
in das Modul der Tabelle, auf die der Code wirken soll:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, arrZ, colZ As New Collection, ii As Long
arrZ = Array(13, 20, 28, 15)     ' Nummern der überwachten Zeilen anpassen
For Each rng In Target           ' falls mehrere Zellen auf einmal geändert
If Not IsError(Application.Match(rng.Row, arrZ, 0)) Then
On Error Resume Next
colZ.Add rng.Row, CStr(rng.Row)     ' hier werden Dubletten vermieden
On Error GoTo 0
End If
Next rng
For ii = 1 To colZ.Count
ZeilenhoeheVerbundene colZ(ii) ' Höhen der gesammelten Zeilen optimieren
Next ii
Set colZ = New Collection
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Automatische Zellenhöhe bei verbunden Zellen
01.03.2016 13:49:20
Steve
Hallo Tom,
im Grunde musst du nur deine IsError-Prüfung im Change-Event der Sheets weglassen. Ich würde es jedoch auskommentieren, damit du es bei Bedarf wieder reinmachen kannst:
--------------------------------------------------------------------
in das Modul der Tabelle, auf die der Code wirken soll:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, arrZ, colZ As New Collection, ii As Long
arrZ = Array(13, 20, 28, 15)     ' Nummern der überwachten Zeilen anpassen
For Each rng In Target           ' falls mehrere Zellen auf einmal geändert
'If Not IsError(Application.Match(rng.Row, arrZ, 0)) Then
On Error Resume Next
colZ.Add rng.Row, CStr(rng.Row)     ' hier werden Dubletten vermieden
On Error GoTo 0
'End If
Next rng
For ii = 1 To colZ.Count
ZeilenhoeheVerbundene colZ(ii) ' Höhen der gesammelten Zeilen optimieren
Next ii
Set colZ = New Collection
End Sub
Wenn du jetzt alle Zeilen einmal angepasst haben willst, kopiere dir die Spalte A und füge sie wieder ein.
lg Steve

Anzeige
AW: Automatische Zellenhöhe bei verbunden Zellen
01.03.2016 15:24:56
Tom
Hi Steve,
ok, danke funktioniert, aber nicht in Verbindung mit dem folgenden Code. Woran liegt es?
Dim Zeile As Long
Dim Spalte As Long
With Sheets("KSW_ESW Übersicht")
.Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)).Copy
.Cells(2, 1).End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
.Range(.Cells(1, 1), .Cells(2, 1).End(xlDown)).EntireRow.Sort _
key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
End With
'--- Zeilen färben
With Sheets("KSW_ESW Übersicht")
For Zeile = 2 To .Cells(2, 1).End(xlDown).Row Step 4
.Cells(Zeile, 1).Resize(2, .UsedRange.Columns.Count).Interior.Color = RGB(200, 200, 200)
Next
End With
'--- Zellen verbinden
With Sheets("KSW_ESW Übersicht")
For Zeile = 2 To .Cells(2, 1).End(xlDown).Row Step 2
For Spalte = 1 To .Cells(1, 2).End(xlToRight).Column
Select Case Spalte
Case 29 To 30
Case Else
Application.DisplayAlerts = False
.Cells(Zeile, Spalte).Resize(2, 1).MergeCells = True
Application.DisplayAlerts = True
End Select
Next
Next
End With
End S

Gruß Tom

Anzeige
AW: Automatische Zellenhöhe bei verbunden Zellen
01.03.2016 16:05:58
Steve
Das liegt daran, dass "MergeCells" keine Wertänderung einer Zelle darstellt und damit das Event nicht ausgelöst wird. Du kannst dein Makro ja mit einer kurzen Zeile überlisten:
Columns("A").Copy Columns("A")
Allerdings wird am Anfang deines Makros beim Copy-Befehl jedes Mal dein Change-Event ausgeführt, _ und deine Zeilen überprüft, was ja nicht sein muss wenn wir am Ende eh nochmal alle überarbeiten. Daher lohnt es sich mit dem Befehl

Application.EnableEvents = False
zu Beginn dies zu verhindern und vor der Zeile "Columns("A").Copy Columns("A")" wieder einzuschalten (= True).
lg Steve

Anzeige
AW: Automatische Zellenhöhe bei verbunden Zellen
01.03.2016 16:59:15
Tom
wohin müssen die Befehle den genau? Ich habe es getestet, aber bleibt unverändert?!?
Grüße Tom

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige