başlangıç ve bitiş arasındaki süreyi ölçmek

[peleryn]

Herkese Merhabalar;

Ek'teki dosyada daha ayrıntılı bir şekilde açıkladığım sorum şöyle bir soru:

E3:E110 arasındaki alanda mümkün olduğunca seri bir şekilde yapılması gereken bir eylemler dizisi var.E3 hücresi bu eylemlerin başlangıç noktası E110 hücresi de bitiş noktası.E3'e doğru veri girilmesi ile başlayan bir sayaç ileri doğru saniye sayacak ve E110'a doğru veri girilip çıkıldığında duracak ve sonucu bir mesajla iletecek.Söylediğim gibi ayrıntılı açıklama dosyada mevcut..

İlgilenecek olanlara şimdiden teşekkür ediyorum.

 

[leumruk]

Merhaba,
Eklediğim örneği inceleyin. E3'e veri girdiğinizde başlar. Kendinize göre koşullar ekleyebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("e3")) Is Nothing Then Exit Sub
    Dim İlk As Date, Son As Date, Süre As Date
    İlk = Time
    Do While [e110] = ""
    DoEvents
    Loop
    Son = Time
    Süre = Format((Son - İlk), "hh:mm:ss")
    MsgBox "Geçen süre: " & Süre, vbInformation, "SONUÇ"
End Sub

 

[peleryn]

Hocam Merhabalar;

Çok teşekkür ederim tam istediğim gibi çalışıyor.MsgBox'ı ve G2 hücresini ben düzenlerim.Ama benim Worksheet_Change olayına yazdığım kodları kaldırmışsınız bir süre denemek için vaktim olmayacak yavaşlatma,birlikte çalışmama gibi özel bir sorun mu vardı da kaldırdınız.Bilgilendirirseniz sevinirim..

 

[peleryn]

Mustafa Hocam eğer worksheet_change kodları çalışmışsa sonlanmış bile olsa dosyayı kapatırken Type Mismatch şeklinde bir hata veriyor.Debug'ta desem End'de desem dosya kapanıyor hata veren bir satır göstermiyor.Bu durumda ne yapmam gerekir?

 

[peleryn]

Ekteki dosyayı birisi inceleyebilir mi sanki makro sonlanmıyor ne oluyor anlamadım.

 

[leumruk]

Merhaba,
Bu satırı:

If Intersect(Target, Range("e3")) Is Nothing Then Exit Sub

Bununla değiştirin:

If Intersect(Target, Range("e3")) Is Nothing Or [COLOR="DarkRed"]Target = ""[/COLOR] Then Exit Sub

 

[peleryn]

Anladım hocam teşekkür ederim.Uygulayacağım sonucu bildirirm..

 

[leumruk]

Anladım hocam teşekkür ederim.Uygulayacağım sonucu bildirirm..

Sonuçta kod hücre değiştiğinde çalışıyor. Hücrenin silinmesi de hücrenin değişmesi anlamına geliyor. Kod arkaplanda çalıştığından siz farkedemiyorsunuz. Bu nedenle kapatırken kod çalışır durumda olduğundan hata veriyor.

 

[peleryn]

Mustafa Hocam çok teşekkür ederim sorun halloldu.Bu çalışmadan çok fayda göreceğiz tekrar sağolun..

 

[leumruk]

Mustafa Hocam çok teşekkür ederim sorun halloldu.Bu çalışmadan çok fayda göreceğiz tekrar sağolun..

Rica ederim.

 

[leumruk]

Hocam Merhabalar;

Çok teşekkür ederim tam istediğim gibi çalışıyor.MsgBox'ı ve G2 hücresini ben düzenlerim.Ama benim Worksheet_Change olayına yazdığım kodları kaldırmışsınız bir süre denemek için vaktim olmayacak yavaşlatma,birlikte çalışmama gibi özel bir sorun mu vardı da kaldırdınız.Bilgilendirirseniz sevinirim..

Merhaba,
Yapmaya çalıştığınızı inceleyince süre için arkada döngü çalıştırmaya gerek olmadığını fark ettim. Aşağıdaki kodu deneyin. Sizin kodlarınızı da uygun yerlerine yerleştirdim.
Bilgisayarınızın yorulmaması ve bir sıkıntıyla karşılaşmamanız açısından süreyi döngü kullanmadan aşağıdaki gibi ölçmek daha sağlıklı olacaktır.

[COLOR="darkred"]Dim İlk As Date, Son As Date, Süre As Date[/COLOR]
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("e3:e110")) Is Nothing Or Target = "" Then Exit Sub
If Target.Row = [e3].Row Then [COLOR="DarkRed"]İlk = Time[/COLOR]
If [a110] * [c110] = [e110] And [e110] <> "" Then
[COLOR="darkred"]    Son = Time
    Süre = Format((Son - İlk), "hh:mm:ss")[/COLOR]
    MsgBox "Geçen süre: " & Süre, vbInformation, "SONUÇ"
    [e3].Select
        If [g2] > Süre Then
            MsgBox "En iyi zamanı yaptınız:" & Süre
            [g2] = Süre
        Else
            MsgBox "en iyi zamanla aranızda " & Süre - [g2] & " kadar fark var."
        End If
        Range("e3:e110").ClearContents
End If
If Target.Value = Cells(Target.Row, 1) * Cells(Target.Row, 3) Then
    Cells(Target.Row + 1, 5).Select
Else
    Target.Select
    Selection.ClearContents
End If
End Sub

 

[peleryn]

Mustafa Hocam;

Konuyu sonlandırmamanız benim açımdan çok hoş bir sürpriz oldu teşekkür ederim.Diğer kodların eklenmesine çok sevindim.Fakat gözlemlediğim kadarıyla sayaç sistem saatini kullanıyor ancak sonucu vermek için başlangıç saatinden bitiş saatini çıkarması için kod yazılmış olduğu halde çıkarmıyor gibi geldi bana..Bir bakarsanız sevinirim.

 

[peleryn]

Yukardaki kodlarda İlk = Time ve Son = Time bu iki yerde de ilk sistem saatini alıyor.Oysa Son = Time dediğinde o anki sistem saatinin aktarılması gerekiyor.Birkaç şey denedim ama işin içinden çıkamadım.

 

[leumruk]

Merhaba,
Aşağıdaki satırın kodun dışında en üstte olması gerekiyordu. Kodu doğru vermişim; ama örnek dosyada iç kısımda bırakmışım. Üstteki dosyayı güncelledim.

Dim İlk As Date, Son As Date, Süre As Date

 

[peleryn]

Hocam şimdi herşeyiyle çok güzel oldu ellerinize sağlık.Zaman içerisinde farklı kullanıcıların kayıtlarını tutan ve kullanıcı performans grafikleri çıkaran bir dosya haline geldiğinde çok daha işlevsel olacak..İlgi ve desteğiniz için tekrar çok teşekkür ediyorum.

 

[leumruk]

Hocam şimdi herşeyiyle çok güzel oldu ellerinize sağlık.Zaman içerisinde farklı kullanıcıların kayıtlarını tutan ve kullanıcı performans grafikleri çıkaran bir dosya haline geldiğinde çok daha işlevsel olacak..İlgi ve desteğiniz için tekrar çok teşekkür ediyorum.

Rica ederim.k::