Office: (Office 2013) Merge von Zellen im exakt definierten Bereich

Hallo zusammen.

Ich habe eine riesige Tabelle (hier bloss ein Ausschnitt), bei der ich zu Visualisierungszwecken, Zellen im ausgewaehlten Bereich (mit gleichem Inhalt je Reihe) verbinden moechte. An sich macht der Code was er soll, allerdings moechte ich da 3 Abfragen einbauen, sodass nach Spalte F, I und L die Zusammenfuehrung mit der naechsten Zelle nicht stattfindet (auch wenn gleicher Inhalt drin), sondern einfach in die naechste Zelle springt (Spalte G, J und M ensprechend) und ab da wie gewohnt weiterlaeuft.

Die Abfragen, die ich ingebaut habe, verbinden die ganze Zeile - da laeuft was total schief.
Unter der Tabelle stehen Beispiele:
Bsp1: wie ich es gerne haben moechte
Bsp2: wie der Code OHNE die 3 Abfragen an Ergebnissen liefert
Bsp3: mit den ungluecklichen Abfragen

Hier der Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim zelle As Range
Dim i As Integer

Application.DisplayAlerts = False

Application.Union(Range("D5", "O7"), Range("D11", "O11")).Select

For Each zelle In Selection
i = 0
Do While zelle = zelle.Offset(0, i)
i = i + 1

'diese Abfrage funktioniert wunderbar
If Intersect(zelle.Offset(0, i), Selection) Is Nothing Then Exit Do

'bei diesen drei Abfragen laeuft was total schief
If Intersect(zelle.Offset(0, i), Cells(zelle.Row, 7)) Is Nothing Then Exit Do
If Intersect(zelle.Offset(0, i), Cells(zelle.Row, 10)) Is Nothing Then Exit Do
If Intersect(zelle.Offset(0, i), Cells(zelle.Row, 13)) Is Nothing Then Exit Do

Loop

Range(zelle, zelle.Offset(0, i - 1)).Merge
Range(zelle, zelle.Offset(0, i - 1)).HorizontalAlignment = xlCenter
Range(zelle, zelle.Offset(0, i - 1)).VerticalAlignment = xlCenter

Next zelle

Application.DisplayAlerts = True
End Sub

Vielen Dank im Voraus fuer Tipps & Tricks bzw Loesung :)

 

Hallo YYY2019,

probier's mal mit

Code:

If [B]Not [/B]Intersect(zelle.Offset(0, i), Cells(zelle.Row, 7)) Is Nothing Then Exit Do
If [B]Not [/B]Intersect(zelle.Offset(0, i), Cells(zelle.Row, 10)) Is Nothing Then Exit Do
If [B]Not [/B]Intersect(zelle.Offset(0, i), Cells(zelle.Row, 13)) Is Nothing Then Exit Do

Gruß,
Lutz

 

Alter, und ich zerbreche mir den Kopf wie bloede.. und es war bloss das "Not" .. Hammer Alter
Aber Danke schoen

Gruss zurueck

 

Hallo YYY2019,

gern geschehen...

Noch ein kleienr Tipp, mit F8 kannst Du Deinen Code Zeile für Zeile durchgehen und schauen, was passiert.
Dazu noch am linken Rand eine Stoppmarke setzen, dann hält Dein Code an einer gewünschten Stelle an und Du kannst Zeile für Zeile durchschauen, was passiert.

Gruß,
Lutz

 

Hallo Lutz,
ja, das habe ich dann auch inzwischen herausgefunden.. laeuft so ähnlich wie bei PyCharm. Nur das Ding ging jedes Mal aus der Schleife raus, ohne, dass ich da grossartig was an Werten sehen konnte bzw wieso die if-Anweisung sich so verhielt. Es gibt doch bestimmt was Besseres zum Arbeiten mit VBA als das standartmaessig eingebaute Tool, oder?

 

Hallo,

ich weiß nicht, ob es was besseres gibt. Evtl. dazu mal nen neuen Thread im Forum aufmachen.
Ich arbeite mit dem Standard und das taugt für mich eigentlich ganz gut.

Zur Überprüfung des Codes habe ich die beiden oben beschriebenen Methoden. Außerdem kannst Du Dir mit Debug.Print Variablen im Direktfenster ausdrucken lassen.
Das Verhalten der If-Abfrage ist etwas undeutlich (hat mich bei Deinem Code auch etwas Zeit gekostet), daher schreibe ich alle If-Abfragen

Code:

If Not Intersect(zelle.Offset(0, i), Cells(zelle.Row, 7)) Is Nothing Then
    Exit Do
End if

Da wird's deutlicher, ob Dein Code den Befehl ausführt oder nicht.

Gruß,
Lutz