Frage von Sam0009, 27

vorhandenes Makro, dass in Spalte D die Zeilen 4 und 5 verbindet, soll nach unten übertragen werden. Sprich 6 und 7, 8 und 9 usw. auch verbinden?

Expertenantwort
von Ninombre, Community-Experte für Excel, 17

Sub merge()
For i = 4 To 100 Step 2
Range(Cells(i, 4), Cells(i + 1, 4)).merge
Next
End Sub

Das For entsprechend anpassen: 4 heißt ab der 4. Zeile. 100 eben bis zur 100sten.

Der Makrorecorder zeichnet einiges an Befehlen auf, die nicht benötigt werden, außer Du willst noch die Ausrichtung der Zellen und ähnliches anpassen.

Dann kannst Du den Code vom Recorder nehmen und nur das Range select ändern


Sub merge()
For i = 4 To 100 Step 2
Range(Cells(i, 4), Cells(i + 1, 4)).select

[... was oben in Deinem Beispiel steht bis einschließlich selection.merge]

Next
End Sub

Kommentar von Sam0009 ,

vielen Dank!

Dieses Makro, welches die Zeilen 4 und 5 blau einfärbt, würde ich auch gerne nach unten weiter laufen lassen, wobei 6 und 7 weiß bleiben sollen. 8 und 9 wieder einfärben usw..

    Range("B4:I5").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
End Sub

Kommentar von Ninombre ,

Da die Abstände der Zeilen, die zu bearbeiten sind, unterschiedlich sind, wäre es einfacher zwei Makros zu machen bzw. zwei For-Schleifen

für das Überspringen von jeweils 2 Zeilen:

for i=4 to 100 step 4
range(cells(i,2),cells(i+1,9)).select

[dein code]

next

Kommentar von Sam0009 ,

Quasi so?

For i = 4 To 100 Step 4
Range(Cells(i, 2), Cells(i + 1, 9)).Select

    Range("B4:I5").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Next
End Sub

Da färbt Excel nur Zeile 4 und 5 mehr nicht :S

Kommentar von Ninombre ,

Range("B4:I5").Select muss gelöscht werden. Damit setzt Du sonst den Bereich (Range) immer fest auf dieser Werte.

Kommentar von Sam0009 ,

Vielen Dank. Hat geklappt!!!

Ich habe hier noch ein Makro, dass ich aufgezeichnet habe und endlos lang ist. Das sind dicke Rahmen um die Doppelzeilen.

Die Sollen bei Zeile 4 anfangen und von B-I gehen. Kannst du das Ding verkürzen?

Rahmen Makro

ActiveCell.Range("A1:H2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    ActiveCell.Offset(2, 0).Range("A1:H2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    ActiveCell.Offset(2, 0).Range("A1:H2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    ActiveCell.Offset(2, 0).Range("A1:H2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    ActiveCell.Offset(2, 0).Range("A1:H2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    ActiveCell.Offset(2, 0).Range("A1:H2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
  End Sub

Vielen Dank im Voraus!

Keine passende Antwort gefunden?

Fragen Sie die Community

Weitere Fragen mit Antworten