Office: (Office 2016) Verbundene Zellen leeren mit Button

Hallo Liebe User
habe folgendes Problem in einer Mappe. Versuche es mal zu beschreiben.
Ein VBA code der eigentlich funktioniert habe ich aus dem Internet gefunden.

Zuerst gibt die Frühschicht ihre Problem , Störungen oder sonstiges ein
dann die Spätschicht danach die Nactschicht .Wenn z.b Die Frühschicht ein Text mit 4 Zeilen eingibt und auf enter drückt passen sich die verbundenen Zellen die höhe an. Gibt dann die Spätschicht ein Text mit 3 Zeilen ein passen sich die Zellen (höhe) auch an.
Doch der Text ( Zellen) von der Frühschicht passt sich auch der Spätschicht an. Da Der Text der Spätschicht nur 3 Zellen groß ist ist der Text der Frühschicht nicht ganz sichtbar.

Frage :


Ist es möglich vorhandenen VBA so zu umprogramieren das B-I 4 oder K-R 4 oder T-AA 4 (Verbundene Zelle)
Zeilenhöhe je nach dem welches den längsten text hat die höhe sich nicht verändert obwohl die anderen Zellen ein kurzen text haben.

Beispiel mappe habe ich eingefügt


PS: ich muss verbundene Zellen benutzen.

 

Hält dir jemand eine Pistole an den Kopf?

 

:-) nein Detlef natürlich nicht aber ich sag mal ich sollte verbundene zellen nutzen.

 

Wenn du keine benutzen würdest, hättest du das Problem nicht...

 

Ich entschuldige mich auch bei dir aber ich benutze 7 möchte es so machen.
Bei allem respekt an alle User ist es nicht möglich das mir jemand hilft ?

 

Dann musst du halt alle Zellen in der Zeile des Target durchgehen und immer die 1.Zelle einer MergedArea so behandeln wie das Target. Du merkst dir einfach die größte PassNewRowHeight und setzt diese dann am Schluss.

Und nein, ich werde das nicht für dich machen. Denn bis das alles sauber funktioniert, z.B. auch wenn mehrere Zellen gleichzeitig geändert werden oder wenn ein Eintrag gelöscht wird, wird der Code deutlich länger und unübersichtlicher werden. Und man (also zumindest ich) sitzt einen halben Tag oder länger dran. Und das alles nur, weil du unverständlicher und überflüssigerweise verbundene Zellen verwenden willst. Nenne mir auch nur einen vernünftigen Grund für dieses Elend.

Und so ganz nebenbei, bezweifle ich, dass du überhaupt weißt, was der Code macht. Sonst hättest du längst diesen Fehler behoben (der nur zufällig nicht den Debugger anspringen lässt):

Code:

.MergeCells = Fals

 

Vielleicht sollte ihm jemand sagen, dass verbundene Zellen und VBA nicht so gut zusammenpassen. :)
Mit diesem seltsamem Code lässt sich das aber "relativ leicht" lösen.
Hab das mal so gemacht, dass der Höhenwert der Zeile in einem anderen Blatt gespeichert wird und dann verglichen.
Nachteil: die Zeilen schrumpfen nicht wieder, wenn was rausgelöscht wird. Es wird immer der letzte Max-Wert verwendet.
Kann sein, dass du zum Testen die Zwischenspeicherzelle auf einem anderen Tabellenblatt als ich bezeichnen musst, die darf nicht auf dem gleichen Blatt liegen wie das Target.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)


Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim TargetWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
Static sngHeigMax As Single

sngHeigMax = Tabelle1.Range("A16")
If Target.MergeCells Then

If Target(1, 1).Value <> "" Then
With Target.Cells(1).MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
TargetWidth = Target.ColumnWidth
For Each CurrCell In Target.MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
iX = iX + 1
Next
MergedCellRgWidth = MergedCellRgWidth + (iX - 1) * 0.71
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit

    If .RowHeight > sngHeigMax Then
      sngHeigMax = .RowHeight
    End If
    PossNewRowHeight = sngHeigMax
.Cells(1).ColumnWidth = TargetWidth
.MergeCells = True
.RowHeight = PossNewRowHeight
.Locked = False

End If
End With
End If

End If

 Tabelle1.Range("A16") = sngHeigMax
End Sub

 

Hallo Czil
Vielen Vielen dank. Funktioniert eigentlich bis auf das was du sagtest das die Zellen nach dem löschen sich nicht verkleinern lassen und das selbst sich Zellen mit Dropdown vergrößern was vorher nicht so war. Wenn es für das Nach dem löschen eine Lösung geben würde hättest du es wahrscheinlich geschrieben oder ??

Kann ich es so ändern das Zellen mit Dropdown sich nicht vergrößern ?

 

Hi,

der Code funktioniert auch nur solange, solange du nur eine solche Zeile in der Tabelle hast.und immer nur eine Zelle änderst.

Die Idee an sich ist prinzipiell gut. Aber ich würde nicht eine einzelne Zelle im anderen Blatt als Zwischenspeicher verwenden, sondern alle Zellen. Und zwar immer die entsprechende Zelle. Also wenn die erste Zelle des Verbunds C3 ist, dann C3 im anderen Blatt. In diese Zelle wird dann immer die ermitteltete notwendige Zellhöhe eingetragen. Und dann braucht man nur noch den Max-Wert aus der entsprechenden Zeile ermitteln und diese dann der aktuellen Zeile zuordnen. dadurch schrumpft die Zellhöhe dann auch, falls sie kleiner werden kann.

 

Stimmt, das ist mir gestern Nacht nicht mehr eingefallen.;)
Aber das wäre die Lösung.
Warum sich Zellen mit Dropdown verändern hängt damit zusammen dass derzeit nur abgefragt wird ob die Zellen verbunden sind. Das müsste man halt noch erweitern. Frage dazu, sind die zu frei auszufüllenden immer in den gleichen Zeilen?

 

Hallo,

ich habe dir im Codemodul der Arbeitsmappe "DieseArbeitsmappe" eine Ereignisbehandlung für das Change-Ereignis, sofern es das Arbeitsblatt "Tabelle1" betrifft, eingebaut. Es gehörte eigentlich in das Codemodul von Arbeitsblatt "Tabelle1", aber dort hast du bereits eine Change-Ereignisbehandlung enthalten. Um einem eventuellen Konflikt auszuweichen, habe ich es auf Arbeitsmappenebene implementiert.

Code:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim ZlFrüh As Integer, ZlSpät As Integer, ZlNacht As Integer
  Dim ZlMax As Integer
  With Sh
    If .Name = "Tabelle1" Then
      If Not Intersect(Target, .Range("$B$4,$K$4,$T$4")) Is Nothing Then
         ZlFrüh = UBound(Split(.Range("B4"), Chr(10))) + 1
         ZlSpät = UBound(Split(.Range("K4"), Chr(10))) + 1
         ZlNacht = UBound(Split(.Range("T4"), Chr(10))) + 1
         ZlMax = WorksheetFunction.Max(ZlFrüh, ZlSpät, ZlNacht)
         'Zeilenanzahl in der Formeleditierzeile anpassen
         Application.FormulaBarHeight = ZlMax
         'Zellenhöhe der Zeile 4 anpassen,
         'wobei die Zeichensatzgröße mit 1.5-fachen Zeilenanzahl vervielfacht wird
         With .Range("B4")
            .RowHeight = .Font.Size * ZlMax * 1.5
         End With
      End If
    End If
  End With 'Sh
End Sub

1) Es fragt zuerst ab, ob Sh=Tabelle1 ist und ob Target in B4/K4/T4 enthalten ist. Falls ja, dann tritt das Makro in Aktion.
2) Es werden die Textzeilen gezählt, die in B4,K4,T4 enthalten sind (ZlFrüh,ZlSpät,ZlNacht), und die maximale Anzahl (ZlMax) ermittelt.
3) Es wird die Formeleditierzeile auf diese ZlMax-Anzahl eingestellt.
4) Dann wird die benötigte Zeilenhöhe für Zeile 4 (.RowHeight) ermittelt, indem die Zeichensatzgröße (.Font.Size) mit dem 1.5-fachen von ZlMax multipliziert wird (um auch die Zeilenzwischenräume in etwa mit einzuplanen).

Datei liegt bei.

 

Auf die Art muss aber nun jede Zeile händisch umgebrochen werden. sonst stimmt die Höhe wieder nicht. Da ist des Ursprungsmakro geschickter.

 

Hallo exl121150
in der Datei die du hochgeladen gast funktioniert alles Super so wie ich es wollte.
Vielen dank. Doch wenn ich es dann in die original Datei übernehme und wie z.b Tabellen Namen und so weiter anpasse funktioniert es nicht mehr. Es entstehen Konflikte. :-(
Vielleicht könntest du mal schauen an was es liegt. in der original Datei ist eigentlich ein Blattschutz die ich ausgesetzt habe.
Lade die original Datei hoch.
Ps:
Mir ist gerade noch aufgefallen das wenn ich in allen Zellen Text lösche ein Fehler kommt " Application.FormulaBarHeight = ZlMax" ist Gelb umrahmt :-(
Lg Polat78

 

Habe ich es nicht von Anfang an gesagt, dass das eine größere Baustelle wird, die du nicht überblickst? Und das alles nur,weil man auf verbundenen Zellen besteht…

 

ich entschuldige mich. Es geht nicht anders. Dann muss ich es wohl aufgeben :-( :-(