Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
18.04.2024 17:45:21
Shellkommando ausführen, stderr auslesen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
440to444
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
440to444
440to444
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

zu großer quellcode

zu großer quellcode
14.06.2004 12:07:27
ralf
Hallo
Ich hab ein makro geschrieben das zeilen mit einer zahl füllt und dann aus der zahl, in eine andere zeile ein datum schreibt.
Am anfang kommt nun die abfrage nach der zahl und dem jahr.
das jahr soll ich nun auf 10 Jahre im voraus programmieren(2004-2014), der quellcode würde dadurch unheimlich lang werden.
er ist jetzt schon über 1000 zeilen lang.
wie kann ich das machen?
wenn ihr wollt(bzw. braucht) kann ich ihn auch reinstellen
Ralf

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: zu großer quellcode
14.06.2004 12:14:02
joel
hallo ralf
das ziel des makros sollte doch sein, das ganze in einer schleife abzuarbeiten, also so in 5-10 zeilen code. du brauchst nicht jeden wert einzeln per makrocode zu schreiben..
beschreib doch ein wenig genauer, was genau dein makro erledigen soll, da gibts sicher eine lösung..
gruss joel
AW: zu großer quellcode
14.06.2004 12:22:27
ralf
Hallo joel
ich will das der nutzer auf einen button klickt, da erscheint dann die erste msgbox
wo er die erste Kalenderwoche eines Quartals eingibt, dann msgbox mit dem jahr,
ich will nun das gesamte quartal mit Kalenderwoche und datum ausfüllen.(also 2spalten).
ich soll das nun so programmieren das er bei der msgbox(jahr) bis 2014 eingeben kann und das dann alles ausfüllt:
Quellcode:
Dim jahr As String
Dim Kalenderwoche As String
Dim neu As String
ThisWorkbook.Sheets("Retail Chemnitz").Activate
ActiveSheet.[a3].Select
jahr = InputBox("Bitte Jahr eingeben", "Jahr eingabe")
If jahr = "" Then Exit Sub
Kalenderwoche = InputBox("Bitte die erste Kalenderwoche des Quartals eingeben", "Quartal")
If Kalenderwoche = "" Then Exit Sub
ActiveCell.Value = Kalenderwoche
If jahr = 2004 Then
If ActiveCell.Value 28 And ActiveCell.Value 15 And ActiveCell.Value 1 And ActiveCell.Value 41 Then Exit Sub
If ActiveCell.Value = 1 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 2
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 3
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 4
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 5
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 6
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 7
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 8
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 9
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 10
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 11
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 12
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 13
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 14
End If
If ActiveCell.Value = 15 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 16
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 17
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 18
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 19
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 20
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 21
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 22
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 23
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 24
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 25
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 26
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 27
End If
If ActiveCell.Value = 28 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 29
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 30
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 31
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 32
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 33
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 34
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 35
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 36
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 37
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 38
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 39
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 40
End If
If ActiveCell.Value = 41 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 42
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 43
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 44
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 45
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 46
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 47
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 48
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 49
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 50
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 51
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 52
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 53
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 15 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "5.04.-11.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 16 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "12.04.-18.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 17 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "19.04.-25.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 18 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "26.04.-02.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 19 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "03.05.-09.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 20 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "10.05.-16.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 21 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "17.05.-23.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 22 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "24.05.-30.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 23 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "31.05.-06.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 24 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "07.06.-13.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 25 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "14.06.-20.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 26 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "21.06.-27.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 27 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "28.06.-04.07."
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 28 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "5.07.-11.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 29 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "12.07.-18.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 30 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "19.07.-25.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 31 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "26.07.-01.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 32 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "02.08.-08.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 33 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "09.08.-15.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 34 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "16.08.-22.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 35 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "23.08.-29.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 36 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "30.08.-05.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 37 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "06.09.-12.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 38 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "13.09.-19.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 39 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "20.09.-26.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 40 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "27.09.-03.10."
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 41 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "4.10.-10.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 42 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "11.10-17.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 43 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "18.10-24.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 44 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "25.10-31.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 45 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "1.11-7.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 46 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "8.11-14.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 47 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "15.11-21.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 48 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "22.11-28.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 49 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "29.11-5.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 50 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "6.12-12.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 51 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "13.12-19.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 52 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "20.12-26.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 53 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "27.12-2.01"
End If
ActiveSheet.[a3].Select
neu = ActiveCell.Value
ThisWorkbook.Sheets("Retail Leipzig").Activate
ActiveSheet.[a3].Select
ActiveCell.Value = neu
If ActiveCell.Value 28 And ActiveCell.Value 15 And ActiveCell.Value 1 And ActiveCell.Value 41 Then Exit Sub
If ActiveCell.Value = 1 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 2
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 3
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 4
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 5
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 6
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 7
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 8
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 9
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 10
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 11
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 12
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 13
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 14
End If
If ActiveCell.Value = 15 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 16
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 17
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 18
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 19
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 20
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 21
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 22
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 23
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 24
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 25
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 26
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 27
End If
If ActiveCell.Value = 28 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 29
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 30
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 31
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 32
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 33
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 34
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 35
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 36
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 37
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 38
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 39
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 40
End If
If ActiveCell.Value = 41 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 42
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 43
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 44
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 45
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 46
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 47
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 48
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 49
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 50
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 51
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 52
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 53
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 15 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "5.04.-11.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 16 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "12.04.-18.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 17 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "19.04.-25.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 18 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "26.04.-02.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 19 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "03.05.-09.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 20 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "10.05.-16.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 21 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "17.05.-23.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 22 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "24.05.-30.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 23 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "31.05.-06.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 24 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "07.06.-13.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 25 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "14.06.-20.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 26 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "21.06.-27.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 27 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "28.06.-04.07."
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 28 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "5.07.-11.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 29 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "12.07.-18.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 30 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "19.07.-25.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 31 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "26.07.-01.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 32 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "02.08.-08.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 33 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "09.08.-15.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 34 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "16.08.-22.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 35 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "23.08.-29.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 36 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "30.08.-05.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 37 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "06.09.-12.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 38 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "13.09.-19.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 39 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "20.09.-26.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 40 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "27.09.-03.10."
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 41 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "4.10.-10.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 42 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "11.10-17.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 43 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "18.10-24.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 44 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "25.10-31.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 45 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "1.11-7.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 46 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "8.11-14.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 47 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "15.11-21.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 48 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "22.11-28.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 49 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "29.11-5.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 50 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "6.12-12.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 51 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "13.12-19.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 52 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "20.12-26.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 53 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "27.12-2.01"
End If
ThisWorkbook.Sheets("Retail Dresden").Activate
ActiveSheet.[a3].Select
ActiveCell.Value = neu
If ActiveCell.Value 28 And ActiveCell.Value 15 And ActiveCell.Value 1 And ActiveCell.Value 41 Then Exit Sub
If ActiveCell.Value = 1 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 2
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 3
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 4
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 5
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 6
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 7
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 8
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 9
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 10
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 11
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 12
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 13
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 14
End If
If ActiveCell.Value = 15 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 16
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 17
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 18
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 19
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 20
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 21
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 22
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 23
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 24
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 25
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 26
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 27
End If
If ActiveCell.Value = 28 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 29
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 30
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 31
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 32
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 33
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 34
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 35
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 36
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 37
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 38
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 39
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 40
End If
If ActiveCell.Value = 41 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 42
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 43
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 44
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 45
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 46
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 47
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 48
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 49
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 50
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 51
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 52
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 53
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 15 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "5.04.-11.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 16 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "12.04.-18.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 17 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "19.04.-25.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 18 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "26.04.-02.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 19 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "03.05.-09.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 20 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "10.05.-16.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 21 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "17.05.-23.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 22 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "24.05.-30.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 23 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "31.05.-06.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 24 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "07.06.-13.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 25 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "14.06.-20.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 26 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "21.06.-27.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 27 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "28.06.-04.07."
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 28 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "5.07.-11.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 29 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "12.07.-18.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 30 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "19.07.-25.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 31 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "26.07.-01.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 32 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "02.08.-08.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 33 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "09.08.-15.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 34 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "16.08.-22.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 35 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "23.08.-29.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 36 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "30.08.-05.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 37 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "06.09.-12.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 38 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "13.09.-19.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 39 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "20.09.-26.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 40 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "27.09.-03.10."
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 41 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "4.10.-10.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 42 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "11.10-17.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 43 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "18.10-24.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 44 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "25.10-31.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 45 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "1.11-7.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 46 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "8.11-14.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 47 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "15.11-21.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 48 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "22.11-28.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 49 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "29.11-5.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 50 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "6.12-12.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 51 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "13.12-19.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 52 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "20.12-26.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 53 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "27.12-2.01"
End If
ThisWorkbook.Sheets("Retail Erfurt").Activate
ActiveSheet.[a3].Select
ActiveCell.Value = neu
If ActiveCell.Value 28 And ActiveCell.Value 15 And ActiveCell.Value 1 And ActiveCell.Value 41 Then Exit Sub
If ActiveCell.Value = 1 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 2
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 3
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 4
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 5
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 6
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 7
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 8
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 9
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 10
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 11
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 12
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 13
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 14
End If
If ActiveCell.Value = 15 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 16
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 17
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 18
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 19
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 20
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 21
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 22
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 23
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 24
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 25
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 26
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 27
End If
If ActiveCell.Value = 28 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 29
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 30
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 31
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 32
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 33
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 34
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 35
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 36
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 37
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 38
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 39
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 40
End If
If ActiveCell.Value = 41 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 42
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 43
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 44
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 45
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 46
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 47
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 48
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 49
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 50
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 51
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 52
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 53
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 15 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "5.04.-11.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 16 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "12.04.-18.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 17 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "19.04.-25.04."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 18 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "26.04.-02.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 19 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "03.05.-09.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 20 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "10.05.-16.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 21 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "17.05.-23.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 22 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "24.05.-30.05."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 23 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "31.05.-06.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 24 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "07.06.-13.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 25 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "14.06.-20.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 26 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "21.06.-27.06."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 27 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "28.06.-04.07."
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 28 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "5.07.-11.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 29 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "12.07.-18.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 30 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "19.07.-25.07."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 31 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "26.07.-01.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 32 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "02.08.-08.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 33 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "09.08.-15.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 34 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "16.08.-22.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 35 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "23.08.-29.08."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 36 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "30.08.-05.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 37 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "06.09.-12.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 38 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "13.09.-19.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 39 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "20.09.-26.09."
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 40 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "27.09.-03.10."
End If
ActiveSheet.[a3].Select
If ActiveCell.Value = 41 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "4.10.-10.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 42 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "11.10-17.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 43 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "18.10-24.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 44 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "25.10-31.10"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 45 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "1.11-7.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 46 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "8.11-14.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 47 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "15.11-21.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 48 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "22.11-28.11"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 49 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "29.11-5.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 50 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "6.12-12.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 51 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "13.12-19.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 52 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "20.12-26.12"
ActiveCell.Offset(1, -1).Select
End If
If ActiveCell.Value = 53 Then
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "27.12-2.01"
End If
End If
End Sub
Anzeige
AW: zu großer quellcode
14.06.2004 13:06:56
joel
hallo ralf
jou, dieser code ist ein wenig lang.. *grins
du brauchst also eine schlaufe.. geeignet wäre hier z.b. eine for-next anweisung
zuerst liest du das jahr und die kalenderwoche ein
(am besten mit abfragekontrolle)
wenn ich richtig verstanden habe, musst du anschliessend ab dem jetzigen datum bis zum eingegebenen datum die kalenderwoche und das datum eintragen
also
for i = 1 to anzKalenderwochen
Tabelle1.cells(i,1).value = i 'kalenderwoche
Tabelle1.cells(i,2).value = ...aktuelles datum + 7*i.. 'datum
next i
ich kann dir momentan nicht die vollständige lösung geben, dazu müsste ich selbst in der hilfe nachschauen. deshalb hier für dich:
suche eine funktion, mit der du die anzahl tage zwischen zwei datums berechnen kannst (anzKalendertage = differenz / 7), evtl. noch runden
weiterhin brauchst du eine funktion, mit der du zu einem datum tage addieren kannst.
und zuletzt brauchst du eine funktion um das aktuelle datum auszulesen
benütze dazu die VBA-hilfe (im vba-editor). da wirst du sicher fündig.
anschliessend helfe ich dir gerne weiter.
gruss joel
Anzeige
AW: zu großer quellcode
Veit
Moin, Moin,
kannst Du mal bitte schreiben, was dann rauskommen soll. Anhand des Codes ist das leider nicht festzustellen.
Gruß
Ein Veit
AW: zu großer quellcode
Uduuh
Hallo,
hier mal als Ansatz:
Option Explicit

Function MoInKW(KW As Integer, Jahr As Integer) As Date
MoInKW = DateSerial(Jahr, 1, 7 * KW - 3 - Weekday(DateSerial(Jahr, 0, 0), 3))
End Function



Sub Quartal()
Dim intKW As Integer, intJahr As Integer, KW As Integer
Dim Z As Integer
intKW = InputBox("Woche?")
intJahr = InputBox("Jahr?")
For Z = 1 To 13
KW = intKW + Z - 1
Cells(Z + 2, 1) = KW
Cells(Z + 2, 2) = Format(MoInKW(KW, intJahr), "DD.MM") & "-" & Format(MoInKW(KW, intJahr) + 6, "DD.MM.YYYY")
Next Z
End Sub

Damit werden ab einer beliebigen Woche 13 Wochen und die zugehörigen Daten (Mo-So) in die Zeilen 3-15 geschrieben.
Gruß aus'm Pott
Udo
http://www.excelerator.de
Anzeige
AW: zu großer quellcode
Ingo
So hats bei mir funktioniert (der Code ist erstmal nur für das Blatt "Retail Chemnitz"
Statt KW in die InputBox Eingabe des Quartal
Sub kw_quartal()
ThisWorkbook.Sheets("Retail Chemnitz").UsedRange.Clear
Dim jahr As Integer
Dim Quartal As Integer
Dim neu As String
Dim i As Integer
Dim Quaralsende As Date, Quartalsanfang As Date
Dim wochenbeginn As Date
ThisWorkbook.Sheets("Retail Chemnitz").Activate
ActiveSheet.[A3].Select
jahr = Val(InputBox("Bitte Jahr eingeben", "Jahreseingabe"))
If IsEmpty(jahr) Then Exit Sub
Quartal = Val(InputBox("Bitte Quartal eingeben", "Quartal"))
If IsEmpty(Quartal) Then Exit Sub
Select Case Quartal
Case 1
Quartalsanfang = DateSerial(jahr, 1, 1)
Quaralsende = DateSerial(jahr, 4, 0)

Case 2
Quartalsanfang = DateSerial(jahr, 4, 1)
Quartalsende = DateSerial(jahr, 7, 0)
Case 3
Quartalsanfang = DateSerial(jahr, 7, 1)
Quartalsende = DateSerial(jahr, 10, 0)
Case 4
Quartalsanfang = DateSerial(jahr, 10, 1)
Quartalsende = DateSerial(jahr + 1, 1, 0)
End Select
Sheets("Retail Chemnitz").[A3] = DINWeek(Quartalsanfang)
Sheets("Retail Chemnitz").[B3] = DINDay(jahr, [A3]) & " bis " & DINDay(jahr, [A3]) + 7
Do
Sheets("Retail Chemnitz").[A3].Offset(i, 0) = DINWeek(Quartalsanfang) + i
wochenbeginn = DINDay(jahr, [A3].Offset(i, 0))
Sheets("Retail Chemnitz").[B3].Offset(i, 0) = DINDay(jahr, [A3]) + 7 * i & " bis " & DINDay(jahr, [A3]) + 7 + i + 7
i = i + 1
Loop Until wochenbeginn > Quartalsende
End Sub
Function DINDay(intYear As Integer, intDIN As Integer)
Dim intDay As Integer, intWeek As Integer
If intYear = 0 Then
DINDay = 0
Exit Function
End If
intDay = 1
intWeek = DINWeek(DateSerial(intYear, 1, 1))
If intWeek 1 Then
Do Until DINWeek(DateSerial(intYear, 1, intDay)) = 1
intDay = intDay + 1
Loop
Else
Do Until DINWeek(DateSerial(intYear, 1, intDay)) 1
intDay = intDay - 1
Loop
intDay = intDay + 1
End If
DINDay = DateSerial(intYear, 1, intDay) + (intDIN - 1) * 7
End Function 

Private Function DINWeek(dat As Date) As Integer
Dim dbl As Double
dbl = DateSerial(Year(dat + (8 - WeekDay(dat)) Mod 7 - 3), 1, 1)
DINWeek = (dat - dbl - 3 + (WeekDay(dbl) + 1) Mod 7) \ 7 + 1
End Function

m f G
Ingo Christiansen
Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige