Excell VBA_Zellen im Range 4 Zellen verbinden nach rechts wenn"", links wenn

Question

Ich komme alleine wohl dieses Jahr nicht ganz ans Ziel, bin erst seit 3 Tagen an VBAs studieren :-( .

Habe durch normale Excell-Formeln im Bereich ("E4:NR42") Zellen mit Inhalt Text "a", "b", "c" oder "d".

Wenn a gefunden, sollte diese mit 4 Zeilen nach rechts verbunden und ausgefüllt mit "a", Interior = 6  

Wenn b - 4 Zellen nach links und auch mit "b" und ausgefüllt. wenn c = 3 Zellen nach rechts, 4 = 3 Zellen nach links.  Alle Felder sind sonst leer. Für diese Hilfe währe ich sehr froh...

Answer 1

Hallo,

ich hoffe, ich habe dich richtig verstanden:

Sub zellen_verbinden()
Dim rngZelle As Range
Dim strInhalt

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

For Each rngZelle In Range("E4:NR42")
  'nur wenn Zelle nicht verbunden ist,
   If rngZelle.MergeCells = False Then
     'dann Inhalt prüfen und ggf. Verbinden
      strInhalt = rngZelle.Value
      Select Case strInhalt
        Case Is = "a"
          With Range(rngZelle, Cells(rngZelle.Row, rngZelle.Column + 3))
            .MergeCells = True             'Zellen verbinden
            .Interior.ColorIndex = 6       'verbundene Zellen füllen
            .Value = "a"                    'a in verbundene Zelle schreiben
           End With
          Case Is = "b"
          With Range(rngZelle, Cells(rngZelle.Row, rngZelle.Column - 3))
            .MergeCells = True
            .Interior.ColorIndex = 8
            .Value = "b"
           End With
           Case Is = "c"
          With Range(rngZelle, Cells(rngZelle.Row, rngZelle.Column + 2))
            .MergeCells = True
            .Interior.ColorIndex = 4
            .Value = "c"
           End With
           Case Is = "d"
          With Range(rngZelle, Cells(rngZelle.Row, rngZelle.Column - 2))
            .MergeCells = True
            .Interior.ColorIndex = 3
            .Value = "d"
           End With
         End Select
      End If
Next rngZelle

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Das Makro gehört in ein Standardmodul (http://www.excelbeispiele.de/Modul.htm) deiner Tabelle. Für die Farben kannst Zahlen zwischen 1 und 56 nehmen.

Gruß

M.O.

Answer 2

Mega - Super. Vielen Vielen Dank Dir M.O.

Brauche halt noch ein paar mal ok zu Drücken für die Bestätigung beim Verbinden.

Denke die Zentrierung des Textes kriege ich hin.

Dein Makro 'nur wenn Zelle nicht verbunden ist, erlaubt mir sogar kleine nachträgliche Änderungen.

Einfach nur Mega lieb. Versuche in den nächsten Tagen das auch noch wirklich zu verstehen.

Smile und nochmals vielen Dank

Tux2

Answer 3

Hallo Tux2,

den Text kannst du wie folgt zentrieren:

.HorizontalAlignment = xlCenter 'Text zentrieren

Im Code sieht das so aus:

With Range(rngZelle, Cells(rngZelle.Row, rngZelle.Column + 3))
            .MergeCells = True             'Zellen verbinden
            .HorizontalAlignment = xlCenter 'Text zentrieren
            .Interior.ColorIndex = 6       'verbundene Zellen füllen
            .Value = "a"                    'a in verbundene Zelle schreiben
End With

Das musst du entsprechend bei den einzelnen Buchstaben ergänzen.

Brauche halt noch ein paar mal ok zu Drücken für die Bestätigung beim Verbinden.

Das sollte aber nicht durch das Makro kommen.

Gruß

M.O.

Answer 4

Danke M.O.

Auch das zentrieren passt. :-)

Die OK. Bestätigungen will Excel: "Beim Verbinden von Zellen bleibt nur der oberste linke Wert erhalten, alle andere Werte werden verworfen".

Gruss

Tux2

Answer 5

Hallo Tux2,

ergänze den Code nach Bildschirmaktualisierung ausschalten wie folgt:

'Benachrichtigungen ausschalten
Application.DisplayAlerts = False

und nach Bildschirmaktualisierung einschalten:

 'Benachrichtigungen einschalten
 Application.DisplayAlerts = True

Damit sollte das Problem mit dem OK-Klicks gelöst sein.

Gruß

M.O.

Answer 6

Hallo M.O.

Grandios! und ich stolpere Ergebnislos über die entscheidenden Details.

Da bin ich sprachlos an Deiner Hilfsbereitschaft 

Leider kann ich mich wohl diesbezüglich nicht revanchieren.

Alles Gute

Gruss

Tux2