Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
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

Re: Spalten per Schleifen einfügen

Re: Spalten per Schleifen einfügen
07.03.2003 09:24:51
Katrin
Hallo Urs,
Hallo alle anderen Excel-Profis,

wir haben uns gestern scheinbar missverstanden. Ich habe eine Tabelle mit den Spaltenüberschriften: Bereich - Erwartungen - Dokument - Meeting1- Meeting2 - Meeting3 - Meeting4 - ...
Nach jeder Spalte mit dem Begriff Meeting möchte ich gern zwei neue Spalten einbauen, die dann die Namen expected und real tragen und verschiedene Formeln enthalten (das wäre das unten genannte Makro).
Wie muß eine Makro-Schleife aussehen, die mir diese Spalten einfügt?

Gruß Katrin

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...)


Sheets("tabelle1").Range("E:F").Insert Shift:=xlToRight
Range("E2").Value = "expected" 'erste neue Spalte soll nun mit expected beschriftet werden
Range("F2").Value = "real" 'zweite neue Spalte soll Bezeichnung real tragen
With Range("E2:" & Range("IV2").End(xlToLeft).Address)
.ColumnWidth = 3
.RowHeight = 60
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 90 'Schrift drehen für Teilüberschriften
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With Range("E1:F1") 'Haupt-Ueberschriftszellen verbinden
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Range("E1:F1").Formula = "=D1" 'Ueberschriftsverweis
'Range("f5").Select
'Spaltenkopf gelb machen
With Range("E1:F3").Interior
.ColorIndex = 36
.Pattern = xlSolid
End With


Gruss
Urs
Bezieht sich auf diese Nachricht:
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Spalten per Schleifen einfügen
09.03.2003 00:20:02
Klaus-Dieter
Hallo Katrin,

anbei ein Lösungsansatz, muß eventuell noch verbessert werden:

Das Makro:


Option Explicit
Sub einfügen()
Dim sp%, r%
sp = Range("IV1").End(xlToLeft).Column
For r = sp To 1 Step -1
If Left(Cells(1, r), 7) = "Meeting" Then
Range(Cells(1, r + 1), Cells(1, r + 2)).EntireColumn.Insert
Range(Cells(1, r + 1), Cells(1, r + 2)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Cells(1, r + 1) = Cells(1, r)
Cells(2, r + 1) = "expected"
Cells(2, r + 2) = "real"
ActiveWindow.ScrollColumn = 44
ActiveWindow.SmallScroll ToRight:=-40
Range(Cells(2, r + 1), Cells(2, r + 2)).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 90
.ShrinkToFit = False
.MergeCells = False
End With
End If
Next r
End Sub

Code eingefügt mit: Excel Code Jeanie

Gruß Klaus-Dieter
Klaus-Dieter's Excel und VBA Seite

Anzeige
Re: Spalten per Schleifen einfügen
10.03.2003 08:23:38
Katrin
Hallo Klaus-Dieter,

der Ansatz sieht super aus. Ich teste ihn gleich mal aus.
Vielen Dank für Deine Hilfe!

Gruß

Katrin

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige