geriye sayım

[queec]

merhabalar. bir geri sayım sayacı yaptım belirlediğim hücreler için fakat 1 den fazla sayaç çalışmıyor.
ne yapabilirim ne ekleyebilirim?
yardımlarınız için teşekkürler.


kullandıgım kodlar aşağıda

Dim StopTimer As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = Me
    
    
    If Not Intersect(Target, ws.Range("P2:P25")) Is Nothing Then
        StopTimer = False
        Countdown ws, Target.Row
    End If
End Sub

Sub StopCountdown()
    StopTimer = True
End Sub

Sub Countdown(ws As Worksheet, row As Long)
    Dim timeCell As Range
    Dim counterCell As Range
    Dim timeValue As Double
    Dim startTime As Double
    
    Set timeCell = ws.Cells(row, 16)
    Set counterCell = ws.Cells(row, 17)
    
    If Not IsEmpty(timeCell.Value) Then
        timeValue = timeCell.Value * 60
        
        Do While timeValue >= 0 And Not StopTimer
            counterCell.Value = Format(TimeSerial(0, 0, timeValue), "hh:mm:ss")
            DoEvents
            startTime = Timer
            Do While Timer < startTime + 1
                DoEvents
            Loop
            timeValue = timeValue - 1
        Loop
    End If
End Sub

 

[pitchoute]

Merhaba, şu şekilde dener misiniz;

Dim StopTimers() As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = Me
    
    If Not Intersect(Target, ws.Range("P2:P25")) Is Nothing Then
        ' Diziyi yeniden boyutlandır ve mevcut değerleri koru
        ReDim Preserve StopTimers(1 To ws.Range("P2:P25").Rows.Count)
        ' İlgili satır için StopTimer değerini False yap
        StopTimers(Target.Row - ws.Range("P2").Row + 1) = False
        ' Geri sayımı başlat
        Countdown ws, Target.Row
    End If
End Sub

Sub StopCountdown(row As Long)
    ' İlgili satır için StopTimer değerini True yap
    StopTimers(row - Range("P2").Row + 1) = True
End Sub

Sub Countdown(ws As Worksheet, row As Long)
    Dim timeCell As Range
    Dim counterCell As Range
    Dim timeValue As Double
    Dim startTime As Double
    
    Set timeCell = ws.Cells(row, 16)
    Set counterCell = ws.Cells(row, 17)
    
    If Not IsEmpty(timeCell.Value) Then
        timeValue = timeCell.Value * 60
        
        Do While timeValue >= 0 And Not StopTimers(row - ws.Range("P2").Row + 1)
            counterCell.Value = Format(TimeSerial(0, 0, timeValue), "hh:mm:ss")
            DoEvents
            startTime = Timer
            Do While Timer < startTime + 1
                DoEvents
            Loop
            timeValue = timeValue - 1
        Loop
    End If
End Sub