Excel Leerzeile (variabel)

Question

Tabelle6
In Zelle A1 habe ich das Startdatum 'Eingabe z.B. 1.2.15

Spalte A SpalteB
Text Tag Datum

Wert ab Zeile 5 bis 35


Nun möchte ich nach ändern des Startdatums nach Sonntag eine Leerzeie eingefügt wird und die Kalenderwocheder Vorwoche ausgegeben wird. Wenn ich dann das Startdatum ändere, müssen die Leerzeilen entsprechend neu definiert werden.
So 1.2.15
KW 6
Mo 2.2.15
Di 3.2.15
Mi 4.2.15
Do 5.2.15
Fr 6.2.15
Sa 7.2.15
So 8.2.15
KW 7
Mo 9.2.15
Di 10.2.15
Mi 11.2.15
Do 12.2.15
Fr 13.2.15
Sa 14.2.15
So 15.2.15
KW 8
Mo 16.2.15
Di 17.2.15
Mi 18.2.15
Do 19.2.15
Fr 20.2.15
Sa 21.2.15
So 22.2.15
KW 9
Mo 23.2.15
Di 24.2.15
Mi 25.2.15
Do 26.2.15
Fr 27.2.15
Sa 28.2.15
KW 10

Answer 1

Boa bin ich doof -

in meinem Gebet heute aben werde ich Gott darum bitten, dass er mir etwas Hirn
zuteil werden lässt.

Nighty hat die Lösung. Hatte nach Ändern in der Zelle B1 nicht das Skript ausgeführt.
Bringt mich hier natürlich auf eine weitere Idee:

Kann man das Script automatisch ablaufen lassen, sobald man in B1 ein anderes Datum einfügt?
Kann man den Wochentagname auf tt formatieren?

Doofis Dank sei Euch schon mal gewiss.

Danke

Answer 2

Hallo,
vielleicht so:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static zb1 As Variant
If zab1 <> Range("B1").Value Then
za1 = Range("A1").Value
Call Kalender1
End If
End Sub


Gruß
fedjo

Answer 3

Hab da einen Fehler gesehen:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static zb1 As Variant
If zb1 <> Range("B1").Value Then
zb1 = Range("B1").Value
Call Kalender1
End If
End Sub

Answer 4

hi all ^^

ein wenig optimiert

gruss nighty

Sub Kalender1()
Dim IntWT As Integer
Range("A5:B" & ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row).Clear
Cells(5, 1).Value = DateSerial(Year(Cells(1, 2)), Month(Cells(1, 2)), Day(Cells(1, 2)))
Cells(5, 1).AutoFill Range("A5:A41")
Range("A5:A41").NumberFormat = "dd.mm.yyyy"
IntWT = 5
If WeekdayName(Weekday(Cells(1, 2) - 1)) <> "Montag" Then
Rows(IntWT & ":" & IntWT).Insert Shift:=xlDown
Range("A" & IntWT).NumberFormat = "KW " & "##"
Cells(IntWT, 1) = EKalenderWoche(Cells(IntWT + 1, 1))
IntWT = IntWT + 1
End If
Do
If Month(Cells(1, 2)) = Month(Cells(IntWT, 1)) Then
Cells(IntWT, 2) = WeekdayName(Weekday(Cells(IntWT, 1) - 1))
If Cells(IntWT, 2) = "Montag" Then
Rows(IntWT & ":" & IntWT).Insert Shift:=xlDown
Range("A" & IntWT).NumberFormat = "KW " & "##"
Cells(IntWT, 1) = EKalenderWoche(Cells(IntWT + 1, 1))
IntWT = IntWT + 1
End If
Else
Cells(IntWT, 1) = ""
Cells(IntWT, 2) = ""
End If
IntWT = IntWT + 1
Loop While IntWT < ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row + 1
End Sub

Function EKalenderWoche(Edatum As Date) As Integer
EKalenderWoche = (Edatum - DateSerial(Year(Edatum + (8 - Weekday(d)) Mod 7 - 3), 1, 1) - 3 + (Weekday(DateSerial(Year(Edatum + (8 - Weekday(d)) Mod 7 - 3), 1, 1)) + 1) Mod 7) \ 7 + 1
End Function

Answer 5

hi all ^^

wochentag 2 stellig

gruss nighty

Sub Kalender1()
Dim IntWT As Integer
Range("A5:B" & ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row).Clear
Cells(5, 1).Value = DateSerial(Year(Cells(1, 2)), Month(Cells(1, 2)), Day(Cells(1, 2)))
Cells(5, 1).AutoFill Range("A5:A41")
Range("A5:A41").NumberFormat = "dd.mm.yyyy"
IntWT = 5
If WeekdayName(Weekday(Cells(1, 2) - 1)) <> "Montag" Then
Rows(IntWT & ":" & IntWT).Insert Shift:=xlDown
Range("A" & IntWT).NumberFormat = "KW " & "##"
Cells(IntWT, 1) = EKalenderWoche(Cells(IntWT + 1, 1))
IntWT = IntWT + 1
End If
Do
If Month(Cells(1, 2)) = Month(Cells(IntWT, 1)) Then
Cells(IntWT, 2) = WeekdayName(Weekday(Cells(IntWT, 1) - 1), True)
If Cells(IntWT, 2) = "Mo" Then
Rows(IntWT & ":" & IntWT).Insert Shift:=xlDown
Range("A" & IntWT).NumberFormat = "KW " & "##"
Cells(IntWT, 1) = EKalenderWoche(Cells(IntWT + 1, 1))
IntWT = IntWT + 1
End If
Else
Cells(IntWT, 1) = ""
Cells(IntWT, 2) = ""
End If
IntWT = IntWT + 1
Loop While IntWT < ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row + 1
End Sub

Function EKalenderWoche(Edatum As Date) As Integer
EKalenderWoche = (Edatum - DateSerial(Year(Edatum + (8 - Weekday(d)) Mod 7 - 3), 1, 1) - 3 + (Weekday(DateSerial(Year(Edatum + (8 - Weekday(d)) Mod 7 - 3), 1, 1)) + 1) Mod 7) \ 7 + 1
End Function

Answer 6

hi fedjo ^^

du hast einen zirkelbezug
nutze die ereignisabschaltung

gruss nighty

Answer 7

hi all ^^

könnte dann so aussehen

gruss nighty

einzufuegen alt+f11/projectexplorer/AllgemeinesModul

Sub Kalender1()
Dim IntWT As Integer
With ActiveSheet
.Range("A5:B" & .Range(.Cells(Rows.Count, 1), .Cells(Rows.Count, 1)).End(xlUp).Row).Clear
.Cells(5, 1).Value = DateSerial(Year(.Cells(1, 2)), Month(.Cells(1, 2)), Day(.Cells(1, 2)))
.Cells(5, 1).AutoFill .Range("A5:A41")
.Range("A5:A41").NumberFormat = "dd.mm.yyyy"
IntWT = 5
If WeekdayName(Weekday(.Cells(1, 2) - 1)) <> "Montag" Then
.Rows(IntWT & ":" & IntWT).Insert Shift:=xlDown
.Range("A" & IntWT).NumberFormat = "KW " & "##"
.Cells(IntWT, 1) = EKalenderWoche(ActiveSheet.Cells(IntWT + 1, 1))
IntWT = IntWT + 1
End If
Do
If Month(.Cells(1, 2)) = Month(Cells(IntWT, 1)) Then
.Cells(IntWT, 2) = WeekdayName(Weekday(.Cells(IntWT, 1) - 1))
If .Cells(IntWT, 2) = "Montag" Then
.Rows(IntWT & ":" & IntWT).Insert Shift:=xlDown
.Range("A" & IntWT).NumberFormat = "KW " & "##"
.Cells(IntWT, 1) = EKalenderWoche(.Cells(IntWT + 1, 1))
IntWT = IntWT + 1
End If
Else
.Cells(IntWT, 1) = ""
.Cells(IntWT, 2) = ""
End If
IntWT = IntWT + 1
Loop While IntWT < .Range(ActiveSheet.Cells(Rows.Count, 1), ActiveSheet.Cells(Rows.Count, 1)).End(xlUp).Row + 1
End With
End Sub

Function EKalenderWoche(Edatum As Date) As Integer
EKalenderWoche = (Edatum - DateSerial(Year(Edatum + (8 - Weekday(d)) Mod 7 - 3), 1, 1) - 3 + (Weekday(DateSerial(Year(Edatum + (8 - Weekday(d)) Mod 7 - 3), 1, 1)) + 1) Mod 7) \ 7 + 1
End Function

einzufuegen alt+f11/projectexplorer/DeineTabelle

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$B$1" Then Call Kalender1
Application.EnableEvents = True
End Sub

Answer 8

Hallo nighty,

Habe die Makros aus AW17 getestet, ist für meine Begriffe eine super Lösung - gratuliere.

Leerzeilen gibt es zwar keine, sind aber meiner Meinung nach verzichtbar.

schönen Tag noch

Gruß
Paul1