Hochzähler bei neuer KW zurücksetzen
29.09.2006 07:17:29
flux
Ich bräuchte nochmal eure Hilfe!
Es handelt sich um diese Makro von UweD!
Vll könntest du mir da auch nochmal helfen!?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Neu$, Konst$, Jahr$, KW As Byte, tmp As Date, Lnr%, Zelle
Set Zelle = Sheets("Tabelle1").Range("A1") 'Rechnungsnummer steht in A1
Jahr = Format(Date, "YY")
Konst = "M"
'aktuelle KW ermitteln
tmp = DateSerial(Year(Date + (8 - Weekday(Date)) Mod 7 - 3), 1, 1)
KW = ((Date - tmp - 3 + (Weekday(tmp) + 1) Mod 7)) \ 7 + 1
If Zelle.Value = "" Then 'neu anlegen
Neu = Konst & Jahr & KW & "1"
Else
If KW > Mid(Zelle, 4, 2) Then 'neue KW
Lnr = 1
Else 'gleiche KW
Lnr = Mid(Zelle, 6) + 1
End If
Neu = Konst & Jahr & KW & Lnr
End If
'Nr. in Zelle schreiben
Sheets("Tabelle1").Range("A1") = Neu
End Sub
Es müsste noch ein Zusatzfeature hinzugefügt werden:
Bei jeder neuen KW soll die fortlaufende Ziffer wieder bei "1" anfangen.
Danke im Voraus!
Gruß
Sebastian