Makro ile Saatten Dakika Çıkarmak

[aborinas]

Merhabalar,
A-B-C-D Sütunlarında 07:42 , 08:15 , 09:20 .... gibi saat verileri yer almaktadır. Ben bu saatlerin hepsinden 20 dakika çıkarmak istiyorum. Örneğin A2 hücresinde 07:42 saati yer alıyor. Makro çalıştırıldığında 07:22 olmasını istiyorum. Tabi bunu sütunlardaki bütün saatlere uygulasın. Şimdiden çok teşekkürler.

 

[veyselemre]

Sub test()
    Dim huc As Range
    For Each huc In Intersect([A:D], ActiveSheet.UsedRange)
        If Not IsEmpty(huc.Value) And IsNumeric(huc.Value) Then
            If huc.Value > TimeSerial(0, 20, 0) Then
                huc.Value = huc.Value - TimeSerial(0, 20, 0)
                Else
                huc.Value = huc.Value + TimeSerial(23, 40, 0)
            End If
        End If
    Next
End Sub

 

[aborinas]

Ellerinize sağlık çok güzel olmuş, çok teşekkürler...

 

[Korhan Ayhan]

Alternatif;

Makro kullanmadan kopyala-özel yapıştır-değerleri-çıkar adımı ile de yapabilirsiniz.

Boş bir hücreye 00:20 yazın.
Sonra bu hücreyi kopyalayın.
Sonra saatlerin bulunduğu hücreleri seçin.
Sağ klik özel yapıştır-değerleri-çıkar komutlarını seçip işlemi tamamlayın.

 

[aborinas]

Tekrar Merhabalar,
Hocam şimdi butona her tıkladığımda 20 dk düşürüyor ben bunun bi defa olmasını istiyorum ikinci defa tıklandığında uyarı versin bunu da yaparsanız çok sevinirim.

 

[veyselemre]

Çalışma kitabı her açıldıktan sonra bir kez çalışacaktır.

Dim calisti As Boolean
Sub test()
    If calisti Then Exit Sub
    calisti = True
    Dim huc As Range
    For Each huc In Intersect([A:D], ActiveSheet.UsedRange)
        If Not IsEmpty(huc.Value) And IsNumeric(huc.Value) Then
            If huc.Value > TimeSerial(0, 20, 0) Then
                huc.Value = huc.Value - TimeSerial(0, 20, 0)
            Else
                huc.Value = huc.Value + TimeSerial(23, 40, 0)
            End If
        End If
    Next
End Sub

 

[aborinas]

Korhan hocam ve Veysel bey ikinize de çok teşekkür ederim. Her iki yöntem de fazlasıyla işe yarıyor.