(15.09.2017, 07:58)Helvetier schrieb: Der Ralf ist auf halbem Weg stehen geblieben.
Na, die andere Hälfte ist ja genauso einfach. ;)
C2 markieren, Ansicht, Fenster fixieren, Fenster fixieren
Dann Microsoft Excel Objekt DieseArbeitsmappe
Hallo Ralf, ich fürchte, dass Du so einiges übersehen hast!: wenn Du das auch noch berücksichtigst, brauchst Du Zeit und es ist dann nicht mehr ganz soooooo einfach.
Gruss
15.09.2017, 12:02 (Dieser Beitrag wurde zuletzt bearbeitet: 15.09.2017, 12:04 von Helvetier.)
Hallo Nike
Im Anhang eine xlsx - Datei und unten der Code. Den Code bitte einbauen im VBAProject unter Tabelle2. Dann unter xlsm abspeichern.
Zum testen:
- ganze Spalte E markieren > rechte Maustaste > Zellen löschen
- den Cursor in Zelle E1 setzen > ein Makro sollte nun eine Spalte einfügen, datieren und die Kreuze eintragen.
Gruss
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sngYa As Single
Dim sngYe As Single
Dim sngY As Single
If Target.Address = "$E$1" Then
If Target < Date Then
Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.ColumnWidth = 2
DatumZellenformat
sngYa = 2
sngYe = ActiveSheet.UsedRange.Rows.Count
sngY = sngYa
Do While sngY < sngYe
If Range("C" & sngY) <= Range("E1") Then
If Range("D" & sngY) >= Range("E1") Then
Range("E" & sngY) = "x"
End If
End If
sngY = sngY + 1
Loop
End If
End If
End Sub
Sub DatumZellenformat()
Range("$E1") = Date
Range("$E1").NumberFormat = "dd/mm/yy;@"
With Range("$E1") 'Selection
'.HorizontalAlignment = xlGeneral
'.VerticalAlignment = xlBottom
'.WrapText = False
.Orientation = 90
'.AddIndent = False
'.IndentLevel = 0
'.ShrinkToFit = False
'.ReadingOrder = xlContext
'.MergeCells = False
End With
With Range("$E1").Font '.Select.Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 8
'.Strikethrough = False
'.Superscript = False
'.Subscript = False
'.OutlineFont = False
'.Shadow = False
'.Underline = xlUnderlineStyleNone
'.ThemeColor = xlThemeColorLight1
'.TintAndShade = 0
'.ThemeFont = xlThemeFontNone
End With
With Range("$E1").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
'.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
With Range("$E1").Borders(xlEdgeTop)
.LineStyle = xlContinuous
'.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
With Range("$E1").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
'.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
With Range("$E1").Borders(xlEdgeRight)
.LineStyle = xlContinuous
'.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
End Sub