Thema Datum  Von Nutzer Rating
Antwort
20.04.2025 17:24:04 Dirk L.
NotSolved
20.04.2025 23:58:20 ralf_b
NotSolved
21.04.2025 13:07:40 Dirk
NotSolved
Blau RFID Chip - Doppelauslösung verhinden
21.04.2025 15:29:40 ralf_b
*****
NotSolved
21.04.2025 15:51:05 Gast34942
NotSolved
21.04.2025 19:23:09 ralf_b
NotSolved
21.04.2025 20:03:30 Gast21699
NotSolved
21.04.2025 20:10:21 Dirk L.
NotSolved
21.04.2025 23:23:49 ralf_b
NotSolved
21.04.2025 20:38:01 ralf_b
NotSolved
21.04.2025 23:11:06 Dirk L.
NotSolved
21.04.2025 23:52:13 ralf_b
NotSolved
22.04.2025 08:28:40 Dirk L.
NotSolved

Ansicht des Beitrags:
Von:
ralf_b
Datum:
21.04.2025 15:29:40
Views:
23
Rating: Antwort:
  Ja
Thema:
RFID Chip - Doppelauslösung verhinden

Dein Code stammt von einer Ki. Nur die kommentiert den Code so. Ich denke das es besser ist nur die reinen Zeiten vom vba Eintragen zu lassen und die andern Werte per Formel zu ermitteln. 

Application.EnableEvents = False/True ist wichtig wenn man in Change Event-Makros Werte in Zellen schreibt. Sonst dreht dein Code bei Jeder Zelländerung eine Extrarunde.  

runnerRow.Offset(0, 6 + runnerRow.Offset(0, 4)).Value = Now  hier wird die Rundenzeit abhängig von der Rundenanzahl in eine neue Zelle geschrieben.

DifferenzMehrAls5 ist eine Funktion, die wahr oder falsch zurückgibt und als Schalter für deine 5 Minutengrenze dient.

 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Überprüfe, ob die Zelle mit den RFID-Daten aktualisiert wurde
    If Target.Address = "$A$3" Then
        Dim rfid As String
        rfid = Target.Value
         
        ' Finde den Läufer in der Tabelle anhand der ID
        Dim runnerRow As Range
        Set runnerRow = Me.Columns("C").Find(What:=rfid, LookIn:=xlValues, LookAt:=xlWhole)
         
        If Not runnerRow Is Nothing Then
            ' Überprüfung, ob eine Startzeit vorliegt
            If IsEmpty(runnerRow.Offset(0, 6).Value) Then
                ' Erfasse die Startzeit beim ersten Erfassen des Chips
                Application.EnableEvents = False
                runnerRow.Offset(0, 6).Value = Now
                Application.EnableEvents = True
            Else
                ' Erhöhe die Rundenzählung bei erneuter Erfassung des Chips
                
                Dim lasttime As Date
                lasttime = WorksheetFunction.Max(runnerRow.Offset(0, 7).Resize(21))
                
                If DifferenzMehrAls5(lasttime, Now) Then
                
                    Application.EnableEvents = False
                     runnerRow.Offset(0, 4).Value = runnerRow.Offset(0, 4).Value + 1
                     runnerRow.Offset(0, 5).Value = Me.Range("G1") * runnerRow.Offset(0, 4)
                     runnerRow.Offset(0, 6 + runnerRow.Offset(0, 4)).Value = Now
                                                                          
                     ' Aktualisiere die reinen Laufzeiten und Differenz
                     runnerRow.Offset(0, 28).Value = Now
                     runnerRow.Offset(0, 29).Value = runnerRow.Offset(0, 28).Value - runnerRow.Offset(0, 6).Value
                      
                    Application.EnableEvents = True
                End If
            End If
             
             
        End If
    End If
End Sub

Function DifferenzMehrAls5(zeita, zeitb) As Boolean
    Dim zeit1 As Date
    Dim zeit2 As Date
    Dim differenz As Double
    
    ' Beispielzeiten setzen
    zeit1 = CDate(zeita)
    zeit2 = CDate(zeitb)
    
    ' Differenz berechnen (in Tagen, deshalb *24*60 für Minuten)
     differenz = Abs(zeit2 - zeit1) * 24 * 60
    
     DifferenzMehrAls5 = differenz > 5
  
End Function

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
20.04.2025 17:24:04 Dirk L.
NotSolved
20.04.2025 23:58:20 ralf_b
NotSolved
21.04.2025 13:07:40 Dirk
NotSolved
Blau RFID Chip - Doppelauslösung verhinden
21.04.2025 15:29:40 ralf_b
*****
NotSolved
21.04.2025 15:51:05 Gast34942
NotSolved
21.04.2025 19:23:09 ralf_b
NotSolved
21.04.2025 20:03:30 Gast21699
NotSolved
21.04.2025 20:10:21 Dirk L.
NotSolved
21.04.2025 23:23:49 ralf_b
NotSolved
21.04.2025 20:38:01 ralf_b
NotSolved
21.04.2025 23:11:06 Dirk L.
NotSolved
21.04.2025 23:52:13 ralf_b
NotSolved
22.04.2025 08:28:40 Dirk L.
NotSolved