Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1648to1652
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
Inhaltsverzeichnis

Stempeluhr RFID Leser und VBA

Stempeluhr RFID Leser und VBA
15.10.2018 18:31:18
Phillieblunt
Schönen guten Abend,
würde mir gerne aus einem RFID Leser eine Stempeluhr bauen.
Hab auch immerhin schon geschafft, dass Datum und Zeit eingetragen wird.
Jetzt hätte ich gerne, dass das System unterscheidet ob ich ein- oder ausstempel und dann die Summe ausrechnet.
Beachten: ein- und ausstempeln muss nicht unbedingt am selben Tag sein.
https://www.herber.de/bbs/user/124636.xlsm
Vg Philipp

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Stempeluhr RFID Leser und VBA
15.10.2018 22:32:41
onur
Das ist nicht so einfach, wie du glaubst.
Wenn das Lesegerät Daten nicht speichert, müsste das Makro/die Datei permanent im Vordergrund laufen.
Dann brauchst du ein separates Blatt, wo die Stempelzeiten den Mitarbeitern zugeordnet und die Zeitpaare eingetragen werden müssten.
Ausserdem müssen die Zeitpaare auf Plausibilität geprüft werden (z.B. Diff. grösser als 10 Std?) für den Fall, dass Jemand vergessen hat, ein- oder auszustempeln.
Abgesehen davon muss dafür gesorgt werden, dass die Stempelzeiten der MA nicht verändert werden können, denn sie haben meines Wissens nach DOKUMENTENSTATUS.
Anzeige
AW: Stempeluhr RFID Leser und VBA
19.10.2018 07:03:54
Phillieblunt
Hallo Onur,
vielen Dank für Deine Nachricht. Ganz so streng, mit Dokumentenstatus, würde ich das in meinem Fall nicht betrachten, da Excel ein reines Hobby von mir ist und es in diesem Fall nicht darauf ankommt. Ich möchte lediglich meine Faulheit beim Schreiben meiner Stundenliste unterstützen :)
Lg Philipp
AW: Stempeluhr RFID Leser und VBA
16.10.2018 10:50:53
UweD
Hallo
wenn du doch sowieso VBA benutzt, dann kannst du auch alles damit berechnen und wegschreiben.
Wie du das Abfragen des Lesers realisierst, weiss ich nicht; aber die Änderungen in Spalte A kannst du so verarbeiten.
Microsoft Excel Objekt Tabelle1
Option Explicit 
Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim Chip As Variant, MA As String 
    Dim Datum As Date, Dauer As Date 
    Dim Z1 As Integer, TB, iZ As Double, WF 
    On Error GoTo Fehler 
     
     
    Z1 = 5 'Überschrift in Zeile 
         
    If Target.Column = 1 And Target.Row > Z1 And Target.Count = 1 Then 
        Set TB = Sheets("Stammdaten") 
        Set WF = WorksheetFunction 
         
        iZ = Target.Row 'aktuelle Zeile 
         
        Chip = Target.Value 
        Application.EnableEvents = False ' Eventschleife verhindern 
         
        'Chip in Stammdaten ? 
        If WF.CountIf(TB.Columns("A:A"), Chip) > 0 Then 
            'Mitarbeiter auslesen 
            MA = WF.VLookup(Chip, TB.Columns("A:B"), 2, 0) 
        Else 
            MsgBox "unbekannter Chip '" & Chip & "'" 
            Target.ClearContents 
            GoTo Fehler ' events auf jeden Fall wieder einschalten 
        End If 
         
        Datum = Now 
         
        Cells(iZ, 2) = Datum 
        Cells(iZ, 4) = Format(Datum, "hh:mm") 
        Cells(iZ, 5) = MA 
         
        'Gerade / ungerade Anzahl Mitarbeiter-Einträge bis zu dieser Zeile ermitteln 
        If WF.CountIf(Cells(Z1, 5).Resize(iZ - Z1 + 1, 1), MA) Mod 2 = 1 Then 'ungerade = Beginn 
             
            Cells(iZ, 6) = "Beginn" 
         
        Else ' es gibt bereits einen Beginn 
         
            Cells(iZ, 6) = "Ende" 
             
            'Zeitdifferenz berechnen (auch über Tage hinweg) 
            Dauer = Datum - _
                       WF.MaxIfs(Cells(Z1, 2).Resize(iZ - Z1, 1), Cells(Z1, 5).Resize(iZ - Z1), MA) 
            Cells(iZ, 7) = Dauer 
            Cells(iZ, 7).NumberFormat = "[hh]:mm" '[Klammern] für Anzeige mehr als 24 Std 
             
        End If 
     
    End If 
     
    '*** Fehlerbehandlung 
    Err.Clear 
Fehler: 
    Application.EnableEvents = True 
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear 
End Sub 
 
 

LG UweD
Anzeige
AW: Stempeluhr RFID Leser und VBA
19.10.2018 07:05:11
Phillieblunt
Hallo Uwe,
das sieht mega aus :) so kann ich mich doch noch ein wenig in VBA versuchen. Werde Dein zur Verfügung gestellten Code heute noch versuchen - melde mich dazu wieder - aber vorab schon mal vielen Dank!
Lg Philipp
AW: Stempeluhr RFID Leser und VBA
19.10.2018 08:50:11
Phillieblunt
Servus Uwe,
mag leider noch nicht so klappen, bei mir..
Magst mal drüber schauen?
https://www.herber.de/bbs/user/124752.xlsm
Danke und Lg Philipp
AW: Stempeluhr RFID Leser und VBA
19.10.2018 09:51:15
UweD
Hallo nochmal
1.
Das Makro MUSS in den Codebereich der Tabelle und NICHT in DieseArbeitsmappe
- Rechtsclick auf den Tabellenblattreiter von Zeiteneingabe
- Code anzeigen
- dort dann diesen Code reinkopieren
2.
- du hast eine Spalte gelöscht, das muss natürlich im Code ÜBERALL angepasst werden
- einige Schreibfehler sind entstanden
= dazu ein Tipp: schreib in die oberste Zeile immer "Option Explicit"
= dadurch werden Schreibfehler meist erkannt, da diese Worte dann als Variable interpretiert werden.
= Da diese Variablen nicht DIMensioniert sind, wird das angemeckert
Hier der angepasste Code
Microsoft Excel Objekt Tabelle1
Option Explicit 
Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim Chip As Variant, MA As String 
    Dim Datum As Date, Dauer As Date 
    Dim Z1 As Integer, TB, iZ As Double, WF 
    On Error GoTo Fehler 
     
     
     
    Z1 = 1 
     
    If Target.Column = 1 And Target.Row > Z1 And Target.Count = 1 And Target <> "" Then 
        Set TB = Sheets("Stammdaten") 
        Set WF = WorksheetFunction 
         
        iZ = Target.Row 
         
        Chip = Target.Value 
        Application.EnableEvents = False 
         
        If WF.CountIf(TB.Columns("A:A"), Chip) > 0 Then 
            MA = WF.VLookup(Chip, TB.Columns("A:B"), 2, 0) 
        Else 
            MsgBox "unbekannter Chip '" & Chip & "'" 
            Target.ClearContents 
            GoTo Fehler 
        End If 
         
        Datum = Now 
         
        Cells(iZ, 2) = Datum 
        Cells(iZ, 3) = Format(Datum, "hh:mm") 
        Cells(iZ, 4) = MA 
         
        If WF.CountIf(Cells(Z1, 4).Resize(iZ - Z1 + 1, 1), MA) Mod 2 = 1 Then 
         
            Cells(iZ, 5) = "Kommen" 
        Else 
            Cells(iZ, 5) = "Gehen" 
             
            Dauer = Datum - _
                WF.MaxIfs(Cells(Z1, 2).Resize(iZ - Z1, 1), Cells(Z1, 4).Resize(iZ - Z1), MA) 
            Cells(iZ, 6) = WF.Ceiling(Dauer, "00:01:00") 'aufrunden auch ganze Minuten 
            Cells(iZ, 6).NumberFormat = "[hh]:mm" 
        End If 
    End If 
     
    Err.Clear 
Fehler: 
    Application.EnableEvents = True 
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear 
 
End Sub 
 

LG UweD
Anzeige
AW: Stempeluhr RFID Leser und VBA
19.10.2018 10:14:58
UweD
Hier nochmal mit Vorbelegung der Spalten
Microsoft Excel Objekt Tabelle1
Option Explicit 
Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim Chip As Variant, MA As String 
    Dim Datum As Date, Dauer As Date 
    Dim Z1 As Integer, TB, iZ As Double, WF 
    Dim SpChip As Integer, SpDatum As Integer, SpZeit As Integer 
    Dim SpMA As Integer, SpArt As Integer, SpDauer As Integer 
    On Error GoTo Fehler 
     
     
     
    Z1 = 1 
     
    If Target.Column = 1 And Target.Row > Z1 And Target.Count = 1 And Target <> "" Then 
        Set TB = Sheets("Stammdaten") ' Daten liegen in A:B 
        Set WF = WorksheetFunction 
         
        'Spaltenfestlegung 
        SpChip = 1: SpDatum = 2: SpZeit = 3: SpMA = 4: SpArt = 5: SpDauer = 6 
         
        iZ = Target.Row 
         
        Chip = Target.Value 
        Application.EnableEvents = False 
         
        If WF.CountIf(TB.Columns("A:A"), Chip) > 0 Then 
            MA = WF.VLookup(Chip, TB.Columns("A:B"), 2, 0) 
        Else 
            MsgBox "unbekannter Chip '" & Chip & "'" 
            Target.ClearContents 
            GoTo Fehler 
        End If 
         
        Datum = Now 
         
        Cells(iZ, SpDatum) = Datum 
        Cells(iZ, SpZeit) = Format(Datum, "hh:mm") 
        Cells(iZ, SpMA) = MA 
         
        If WF.CountIf(Cells(Z1, SpMA).Resize(iZ - Z1 + 1, 1), MA) Mod 2 = 1 Then 
         
            Cells(iZ, SpArt) = "Kommen" 
        Else 
            Cells(iZ, SpArt) = "Gehen" 
             
            Dauer = Datum - _
                WF.MaxIfs(Cells(Z1, SpDatum).Resize(iZ - Z1, 1), Cells(Z1, SpMA).Resize(iZ - Z1), MA) 
            Cells(iZ, SpDauer) = WF.Ceiling(Dauer, "00:01:00") 'Aufrunden auch ganze Minuten 
            Cells(iZ, SpDauer).NumberFormat = "[hh]:mm" 
        End If 
    End If 
     
    Err.Clear 
Fehler: 
    Application.EnableEvents = True 
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear 
 
End Sub 
LG UweD
Anzeige
AW: Stempeluhr RFID Leser und VBA
19.10.2018 11:28:53
Phillieblunt
Super Uwe,
vielen Dank erst Mal für die wertvollen Tips. Wird doch noch n VBA Profi aus mir :)
Leider hab ich aber hier ein Problem.
If WF.CountIf(Cells(Z1, SpMA).Resize(iZ - Z1 + 1, 1), MA) Mod 2 = 1 Then
Cells(iZ, SpArt) = "Kommen"
Else
Cells(iZ, SpArt) = "Gehen"
Dauer = Datum - _
WF.MaxIfs(cells(z1, SpDatum).Resize(iZ-z1,1),cells(z1,SpMA).Resize(iz-z1),MA)
Cells(iZ, SpDauer) = WF.Ceiling(Dauer, "00:01:00")
Cells(iZ, SpDauer).NumberFormat = "[hh]:mm"
End If
In der Zeile Dauer = Datum - _
beim Abschließen dieser Zeile mit Enter, wir ein Fehler ausgegeben:
"Beim Ausführen dieses Befehles wird die Arbeitsmappe zurück gesetzt oder so ähnlich.."
und dann nur noch ein Fehler beim Kompilieren.
Und die Zeile danach, die mit WF.MaxIfs beginnt, meckert er auch an: "erwarte =" sagt er..
Anzeige
AW: Stempeluhr RFID Leser und VBA
19.10.2018 11:49:08
UweD
Hallo
die Zeilen sind als Eine anzusehen.
durch das _[und Leerzeichen davor und dahinter] wird gesagt, dass die Zeile weitergeht
bei dir hat sich eine komplette Leerzeile dazwischengemogelt

Dauer = Datum - _
WF.MaxIfs(Cells(Z1, SpDatum).Resize(iZ - Z1, 1), Cells(Z1, SpMA).Resize(iZ - Z1), MA)

LG UweD

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige