Felder einer Zeile verbinden, wenn Formel-Wert gleich

09/06/2016 - 18:33 von michael-kuschnik | Report spam
Hallo liebe Excel-Kenner :-)
ich habe in meinem Excel-Blatt eine Tabellenzeile, bei der die Zellen-Inhalte durch eine Formel berechnet werden.
Wenn die Werte gleich sind, dann sollen diese Zellen verbunden werden, und der gemeinsame Wert soll mittig dargestellt werden.

Ich habe bereits ein Lösung im Forum gefunden, wenn die Inhalte manuell eingetragen wurden.

Sub VerbindenNebeneinander()
Dim rngZelle As Range, intZàhler As Integer, strAdresse As String
Application.DisplayAlerts = False
For Each rngZelle In ActiveSheet.UsedRange
If Not (IsEmpty(rngZelle) Or rngZelle.HasFormula) Then
intZàhler = 0
Do
strAdresse = rngZelle.Offset(0, intZàhler).Address
intZàhler = intZàhler + 1
Loop Until rngZelle.Value <> rngZelle.Offset(0, intZàhler).Value
ActiveSheet.Range(rngZelle.Address, strAdresse).Merge
End If
Next
Application.DisplayAlerts = True
End Sub

Das klappt auch, aber leider nicht mit Werten aus Formeln.- ist auch im Coding ausgeschaltet - glaube ich zu erkennen.

Eine analoge Lösung fehlt mir auch für Spalten (in einem anderen Blatt).

Kann mir jemand bitte helfen - bin Neu hier und begegne erstmals dem Excel-Skripting

Besten Dank
Michael
 

Lesen sie die antworten

#1 Claus Busch
09/06/2016 - 18:49 | Warnen spam
Hallo Michael,

Am Thu, 9 Jun 2016 09:33:20 -0700 (PDT) schrieb :

ich habe in meinem Excel-Blatt eine Tabellenzeile, bei der die Zellen-Inhalte durch eine Formel berechnet werden.
Wenn die Werte gleich sind, dann sollen diese Zellen verbunden werden, und der gemeinsame Wert soll mittig dargestellt werden.



ich bin eigentlich ein Gegner von verbundenen Zellen. Ich selektiere
lieber die Zellen wie beim Verbinden => Zellen formatieren => Über
Auswahl zentrieren.

Probiere mal an einer Kopie deiner Mappe:

Sub Verbinden()
Dim rngC As Range

Application.DisplayAlerts = False

For Each rngC In ActiveSheet.UsedRange
If rngC = rngC.Offset(, 1) Then
rngC.Resize(1, 2).Merge
End If
Next
Application.DisplayAlerts = True
End Sub


Mit freundlichen Grüßen
Claus
Windows10
Office 2016

Ähnliche fragen