Office: Verbundene Zellen finden, aufheben und wieder zentrieren über Auswahl in Mappe

User · 4. September 2007

Liebe VBA Spezialisten,

verbundene Zellen machen nur Ärger *mad.gif* - Profis wissen was ich meine *cool.gif* . Die bessere Lösung ist die Textausrichtung über die gewünschten Zellen (Strg + 1 / Ausrichtung, Horizontal: "Über Auswahl zentrieren"). Nun habe ich zahlreiche Dateien vor mir "liegen" mit verbundenen Zellen. Wie würde ein Makro aussehen, dass die gesamte aktive Mappe nach solchen Bereichen durchsucht, die Verbindung aufhebt und den gleichen Bereich mit dem Verfahren von oben behandelt?

Wäre super, wenn jemand mich unterstützen könnte.

Anbei mal ein Beispielcode zum Verfahren oben:
Code:

Sub ZentriertÜberSpalten()
'
'anstatt Zellen zu verbinden,
'besser:
'Formatierung der markierten Zellen und Textanordnung Zentriert über Spalten
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

chris-kaiser · 6. September 2007

Hallo woody

vielleicht hilft das

sucht alle Zellen ab ob ein Spaltenunterschiede vorhanden ist
diese werden wiederum durchsucht ob es eine verbundene Zelle ist und ob ein Text in der Zelle steht
wenn Ja, zerlege die Zelle und führe die Formatierung aus.

Sub testi()
'kaiser 2007
Dim rng1 As Range
On Error GoTo msg
Set rng1 = Cells.ColumnDifferences(ActiveCell)
For Each zelle In rng1
If zelle.MergeCells And zelle.Value <> "" Then
With zelle.MergeArea
.UnMerge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlBottom
.Orientation = 0
End With
End If
Next
Exit Sub
msg:
MsgBox Err.Number & " : " & Err.Description
End Sub

Code eingefügt mit
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

User · 6. September 2007

Moin Chris,

vielen Dank für Deine Antwort, leider läuft der Code noch nicht bei mir. Eine Dimensionierung fehlte und dann habe ich noch einen Zähler eingebaut.

Bei meinen Zieldateien erscheint der "Fehler 13: Typen unverträglich". Das mag an meiner angefügten Dimensionierung liegen?

Nehme ich eine leere Mappe und erstelle eine verbundene Zelle mit Inhalt, kommt der "Fehler 1004: keine Zellen gefunden"

Woran könnte es liegen?

Code:

Sub VerbundeneZellenUmwandeln()
't=217441 chris-kaiser
Dim zelle As Range 'fehlte
Dim rng1 As Range
Dim sh As Worksheet
Dim i As Integer
On Error GoTo msg
For Each sh In Worksheets
Set rng1 = sh.Cells.ColumnDifferences(ActiveCell)
For Each zelle In rng1
If zelle.MergeCells And zelle.Value "" Then
With zelle.MergeArea
.UnMerge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlBottom
.Orientation = 0
End With
i = i + 1 'erweitert
End If
Next
Next
MsgBox "Es wurden " & i & " verbundene Zellen umgewandelt!" 'erweitert
Exit Sub
msg:
MsgBox Err.Number & " : " & Err.Description
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

chris-kaiser · 6. September 2007

Hallo Woody

keine Ahnung poste doch mal einfach die Mappe ohne die Orginalinhalte

hier meine demo wo es Problemlos geht

User · 6. September 2007

Hallo Chris,

danke für die Demo - läuft auch bei mir. Die Zieldatei kann ich leider nicht hochladen. Ich konnte durch Selektieren der bearbeitenden Zellen zwar die Stolpersteine bzw. -zellen ausfindig machen, aber leider an denen nichts auffälliges entdecken, weshalb der Code abbricht. Ich habe es nun mit einem "On Error Resume Next" gelöst - das erklärt mir zwar nicht die Hintergründe aber hilft schon mal ungemein weiter. Ich danke Dir für Deinen Einsatz! Das Makro werde ich noch oft verwenden müssen bis ich alle verbundenen Zellen in meinen Arbeitsumfeld gelöscht habe - "resistance is futile" wie die Borg zu sagen pflegen *grins . Schönen Tag bzw. Wochenende ...

chris-kaiser · 6. September 2007

Hallo Woody

*Smilie, was sind den das für Zellen?
kannst Du nicht ein leeres Blatt mit diesen Zellen hochladen.

würde mich interessieren, vielleicht finde ich noch eine allgemein gültige Lösung.

User · 19. Mai 2008

Moin zusammen,
moin chris,

ich habe nun schon länger das obige Makro, minimal abgewandelt, im Gebrauch, aber leider ein Phänomen: nach Durchlauf des Markos durch die gesamte Datei sind noch nicht alle verbundenen Zellen umgewandelt. Ich muss es nochmals laufen lassen. Je nach Menge der Zellen durchaus 3-4 mal. Daher habe ich einen Zähler eingebaut. Ich wiederhole also den Einsatz des Makros solange, bis Null bearbeitete Zellen anzeigt wird.

Nicht gerade optimal. Hat jemand eine Idee was ich ändern müsste, damit es in einem Anlauf klappt?

Code:

Sub A00_VerbundeneZellenUmwandeln()
't=217441 chris-kaiser
Dim zelle As Range
Dim rng1 As Range
Dim sh As Worksheet
Dim i As Integer
Dim j As String
On Error Resume Next 'On Error GoTo msg
For Each sh In Worksheets
j = sh.name
sh.Select
Set rng1 = sh.Cells.ColumnDifferences(ActiveCell)
For Each zelle In rng1
If zelle.MergeCells And zelle.Value "" Then
zelle.Select
With zelle.MergeArea
.UnMerge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter 'xlBottom
.Orientation = 0
End With
i = i + 1 'erweitert
End If
Next
Next
MsgBox "Es wurden " & i & " verbundene Zellen umgewandelt! " & Chr(13) & _
"Makro nochmal laufen lassen bis keine Zelle mehr umgewandelt wird." 'erweitert
Exit Sub
'überflüssig
msg:
MsgBox Err.Number & " : " & Err.Description
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

chris-kaiser · 19. Mai 2008

Hallo Woody

versuche es mal so

Code:

Sub testi()
Dim rng1 As Range
Dim sh As Worksheet
On Error Resume Next 'falls in einem Blatt kein Eintrag ist
For Each sh In Worksheets
Set rng1 = sh.Cells.SpecialCells(xlCellTypeConstants, 23)
For Each zelle In rng1
If zelle.MergeCells Then
With zelle.MergeArea
.UnMerge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlcenter
.Orientation = 0
End With
End If
Next
Next
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ich habe mal angenommen das die verbundenen Zellen einen Eintrag haben oder kann es sein das diese Verbundenen Zellen keinen Eintrag haben?

falls ja ->

Code:

Sub testi1()
Dim rng1 As Range
Dim sh As Worksheet
For Each sh In Worksheets
Set rng1 = sh.Cells.Range("A1:AA1000") 'anpassen!
For Each zelle In rng1
If zelle.MergeCells Then
With zelle.MergeArea
.UnMerge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlcenter
.Orientation = 0
End With
End If
Next
Next
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

dauert zwar länger aber so müssten wirklich alle Zellen erkannt werden!

p.s müsste auch ohne select gehen

ansonsten lösche einfach alles aus der Mappe bis auf die verbundenen Zellen
und hänge diese leere Mappe mal an.

User · 20. Mai 2008

Hallo Chris,

es klappt! Ich habe nun den 2. Code von dir mehrfach getestet und es läuft sehr gut. Es klappt auf Anhieb in einem Durchlauf.

Herzlichen Dank für den erneuten Einsatz! *five

Anbei der auf meine Bedürfnisse erweiterte Code:

Code:

Sub A00_VerbundeneZellenUmwandeln()
't=217441 chris kaiser
Dim rng1 As Range
Dim zelle As Range
Dim sh As Worksheet
Dim blatt As String
Dim i As Integer

For Each sh In Worksheets
Set rng1 = sh.Cells.Range("A1:AZ1000") 'anpassen!
For Each zelle In rng1
If zelle.MergeCells Then
With zelle.MergeArea
.UnMerge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Orientation = 0
End With
i = i + 1 'erweitert
End If
Application.StatusBar = "... wandle in Blatt: " & sh.name & " die " & i & ".Zelle um"
Next
Next
MsgBox "Es wurden " & i & " verbundene Zellen umgewandelt! "
Application.StatusBar = False
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

chris-kaiser · 20. Mai 2008

Hallo Woody

sehr schön!
und danke für die nette Rückmeldung*hands

Office: Verbundene Zellen finden, aufheben und wieder zentrieren über Auswahl in Mappe

Verbundene Zellen finden, aufheben und wieder zentrieren über Auswahl in Mappe

Verbundene Zellen finden, aufheben und wieder zentrieren über Auswahl in Mappe

Verbundene Zellen finden, aufheben und wieder zentrieren über Auswahl in Mappe

Verbundene Zellen finden, aufheben und wieder zentrieren über Auswahl in Mappe

Verbundene Zellen finden, aufheben und wieder zentrieren über Auswahl in Mappe - Similar Threads - Verbundene Zellen aufheben

Daten Einlesen aus mehre Zellen in Verbindung einer Verbundene Zelle

Spalten sortieren, wenn die ersten 2 Zeilen aus verbundenen Zellen bestehen

Excel: längeren Text auf gesamte verbundene Zellen ausbreiten

Verbundene Zellen leeren mit Button

Bedingte Formatierung mit verbundenen Zellen

fehlerhafte DropDown Liste von verbundenen Zellen

Verbundene Zellen mit Makro Verbund aufheben