so langsam wachsen ja meine VBA-Kenntnisse, nur bei Schleifen muss ich komplett passen, dafür langt es dann doch nicht:
Ich möchte, dass folgende Anweisungen für eine x-beliebige Spaltenanzahl vorgenommen werden. Das unten angegebene Makro ist für die Ursprungsspalte D gedacht und soll nun auch für alle nachfolgenden Spalten analog funktionieren Wie stell ich das an?
Gruß
Katrin
Sub schleife()
'
Sheets("tabelle1").Select
'D ist Startspalte, ab da soll im Ausgangsspaltentableau nach jeder Basisspalte zwei neue Spalten eingefügt werden
Range("E:F").Select
Selection.Insert Shift:=xlToRight
Range("E2").Select 'erste neue Spalte soll nun mit expected beschriftet werden
ActiveCell.FormulaR1C1 = "expected"
Range("F2").Select 'zweite neue Spalte soll Bezeichnung real tragen
ActiveCell.FormulaR1C1 = "real"
Dim beschr1 As String
Dim beschr2 As String
Dim beschriftung As String
beschr1 = Range("E2").Offset(0, 0).Address
beschr2 = Range("IV1").End(xlToLeft).Offset(1, 0).Address
beschriftung = beschr1 & ":" & beschr2
Range(beschriftung).Select
Selection.ColumnWidth = 3
Selection.RowHeight = 60
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 90 'Schrift drehen für Teilüberschriften
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("E1:F1").Select 'Haupt-Ueberschriftszellen verbinden
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Range("E1:F1").Select 'Ueberschriftsverweis
ActiveCell.FormulaR1C1 = "=RC[-1]"
Range("f5").Select
'Spaltenkopf gelb machen
Range("E1:F3").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
' Formel eintragen in Spalte
Dim spal1 As String
Dim spal2 As String
Dim spalte As String
Range("E5").Select
spal1 = Range("E5").Offset(0, 0).Address
spal2 = Range("b65536").End(xlUp).Offset(0, 3).Address
spalte = spal1 & ":" & spal2
Range(spalte).Formula = "=IF(RC[-1]<>"""",3,"""")"
'Spalte und Schrift einfärben
Dim Mark1 As String
Dim Mark2 As String
Dim Markierung As String
Mark1 = Range("D1").Offset(0, 0).Address
Mark2 = Range("B65536").End(xlUp).Offset(0, 2).Address
Markierung = Mark1 & ":" & Mark2
Range(Markierung).Select
Selection.Interior.ColorIndex = 15 'Hintergrund
Selection.Font.ColorIndex = 15 'Schriftfarbe
Selection.ColumnWidth = 3
' bedingte Formatierung für Ampelfarben
Dim Bereich1 As Range
Dim Bereich2 As Range
Dim Gesamtb As Range
Set Bereich1 = Range(Range("E3"), _
Range("E3").End(xlDown))
Set Bereich2 = Columns("E:VI")
Set Gesamtb = Union(Bereich1, Bereich2)
Gesamtb.Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="3"
Selection.FormatConditions(1).Interior.ColorIndex = 50
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="2"
Selection.FormatConditions(2).Interior.ColorIndex = 27
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="1"
Selection.FormatConditions(3).Interior.ColorIndex = 3
End Sub