Hallo Edgar,
habe eine Frage da zu VBA da ich einen Wert nicht finden kann!
Für 80 Prozent der Mitarbeiter passt diese ZK super, jedoch haben wir auch MA die 41Std arbeiten und daher Montag u. Dienstag erst von 16:30 Überstunden schreiben können.
Deshalb habe ich zweite Schaltfläche gemacht und die Werte zu ändern versucht (kopiertes Makro) auf 16:30.
Für die Darstellung in der ZK klappt es super nur beim Übertrag nimmt er noch immer 16:00.
rngAktiv.Offset(0, 2) = "16:30"
Wo muss ich hier noch den Eintrag im Makro ändern damit auch bei Beginn Überstunde 16:30 übertragen wird?
Code:
Sub Stunden_speichern()
Dim loletzte As Long
Dim loSp As Long
Dim loZe As Long
Dim IstDa As Boolean
Dim rngAktiv As Range
Dim rng As Range
Dim rng2 As Range
Dim Blatt As Long
Dim strArchiv As String
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Set wksQ = Sheets("ZK")
Set wksZ = Sheets("MDL")
IstDa = False
Set rng = Union(wksQ.Range("D16:D31"), wksQ.Range("N16:N30"))
loletzte = wksZ.Cells(Rows.Count, 2).End(xlUp).Row + 1
Set rngAktiv = ActiveCell
If rngAktiv.Count > 1 Then Exit Sub
If Application.Intersect(rngAktiv, rng) Is Nothing Then Exit Sub
If Not wksZ.Columns(2).Find(rngAktiv.Offset(0, -1).Value + 2 / 3) Is Nothing Then
MsgBox "Der Wert wurden bereits gespeichert!", vbOKOnly, "Achtung"
Exit Sub
End If
Application.ScreenUpdating = False
With wksQ
wksZ.Cells(loletzte, 2) = rngAktiv.Offset(0, -1) + 2 / 3
wksZ.Cells(loletzte, 4) = rngAktiv.Offset(0, -1) + rngAktiv.Offset(0, 2)
wksZ.Cells(loletzte, 6) = Format((rngAktiv.Offset(0, 4) + rngAktiv.Offset(0, 5) / 60) / 24, "hh:mm")
strArchiv = "Stunden_" & Format(.Range("P10") * 29, "MMM")
rngAktiv.Offset(0, 2) = "16:30"
Debug.Print strArchiv
For Blatt = 1 To Sheets.Count
If Sheets(Blatt).Name = strArchiv Then IstDa = True
Next
If Not IstDa Then
wksQ.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Stunden_" & Format(.Range("P10") * 29, "MMM")
With Sheets(Sheets.Count).UsedRange
.Value = .Value
End With
Else
.Range("B16:U31").Copy
Sheets(Sheets.Count).Range("B16").PasteSpecial xlPasteValues
End If
With Sheets(Sheets.Count).UsedRange
.Value = .Value
End With
End With
Application.ScreenUpdating = True
End Sub
Danke und nochmal Sorry dass ich dich schon wieder belästige!!
Erika
PS: auch sollen die Mitarbeiter durch einen andere Schaltfläche die Möglichkeit bekommen von frühestens 06:00 bis max 08:00 (z.B. 06:30-08:00; 06:45-08:00; 07:30-08:00 Überstunden schreiben zu können.
kann ich dieses auch mit deinem Makro umsetzen?
