Anzeige
Archiv - Navigation
228to232
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
228to232
228to232
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Spalten per Schleifen einfügen

Spalten per Schleifen einfügen
06.03.2003 15:01:05
Katrin
Hallo zusammen,

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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Spalten per Schleifen einfügen
06.03.2003 18:14:19
Urs

Hallo Katrin,
alles viel zu aufwändig... Auf select sollte soweit wie möglich verzichtet werden.
Als Beispiel habe ich Dir den ersten Teil Deines Codes angepasst.
Ansonsten ist nicht ganz klar, was Du wie oft willst (irgendwann ist ja fertig mit den Spalten...)

Gruss
Urs

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige