Çözüldü Mesai saati farkını bulma ve hesaplama

[sirkülasyon]

Buton (Makro) yardımı ile
VERİLER
C2 hücresine Yıl manuel girilecek
C3 hücresine ay manuel girilecek
Option buttonda yapılan manuel seçim
G2 hücresine Giriş Saati manuel girilecek
G3 hücresine Bitiş Saati manuel girilecek
TABLO
Günler Sütununa seçilen ay ve yıla göre günler
Başlama Tarihi sütununa seçilen ay ve yıla göre tarih
Giriş Saati sütununa girilen saat
Bitiş Tarihi sütununa seçilen ay ve yıla göre tarih
Çıkış Saati sütununa girilen saat
Mesai Saati sütununa bitiş ve çıkış saati arasında ki mesai saati farkı
HESAPLAMA
F39 hücresi = Mesai Saati toplamı
F40 hücresi =Manuel Girilecek
F41 hücresi = F39 - F40 farkı
F42 hücresi = Manuel Girilecek
F43 hücresi = Manuel Girilecek
F44 Hücresi = F42 X F43 çarpımı
F45 hücresi = F40 X F44 çarpımı
F47 hücresi = F45 X F47 çarpımı
F48 hücresi = F45 X F48 çarpımı
F49 hücresi = F47 + F48 toplamı
F50 hücresi = F45 X F49 farkı
Boş Satırlar Gizlenecek
Rica etsem makro ile hesaplama yapılması konusunda yardımcı olabilir misiniz?
Teşekkür eder saygılarımı sunarım

İlgili Dosya

 

[Ömer BARAN]

Merhaba.

Alt taraftan ilgili sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılacak VBA ekranında sağdaki boş alana aşağıdaki kodları yapıştırın.

Private Sub OptionButton1_Click()
    DOLDUR
End Sub

Private Sub OptionButton2_Click()
    DOLDUR
End Sub

Sub DOLDUR()
If [B6] <> "" Then Range("B6:G36").ClearContents
Rows("6:36").EntireRow.Hidden = True: ilk = Empty
aylar = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", "Eylül", "Ekim", "Kasım", "Aralık")
On Error Resume Next
ilk = DateValue("1." & WorksheetFunction.Match([C3], aylar, 0) & "." & [C2])
If ilk = Empty Or [C2] = "" Or [C3] = "" Or [G2] = "" Or [G3] = "" Or [G2] > [G3] Then
    MsgBox "Üst kısımdaki verileri kontrol ediniz!", vbCritical
    Exit Sub
End If
son = CDate(WorksheetFunction.EoMonth(ilk, 0))

For gun = 1 To Day(son)
    sat = [B37].End(3).Row + 1
    tarih = CDate(ilk + gun - 1)
    Rows(sat).EntireRow.Hidden = False
    If OptionButton1 = True And WorksheetFunction.Weekday(tarih, 2) > 5 Then GoTo 10
    Cells(sat, "C") = tarih: Cells(sat, "B") = Format(tarih, "dddd")
    Cells(sat, "D") = [G2]: Cells(sat, "E") = tarih
    Cells(sat, "F") = [G3]: Cells(sat, "G") = ([G3] - [G2]) * 24
10 Next
End Sub

 

[sirkülasyon]

Ömer Abi
Ellerine sağlık. Çok çok teşekkür ederim. Hakkını helal et.
Optin button 3 butonu eklersem eğer. Sadece haftasonu (Cumartesi ve Pazar) günlerinin gelmesi için ne yapmam lazım? Yardımcı olabilir misin?

 

[sirkülasyon]

Ömer abi
Sadece haftasonu (Cumartesi ve Pazar) günlerinin gelmesi için Bakabildiniz mi?

 

[Ömer BARAN]

Merhaba.
>> Aşağıdaki kodu mevcut kodların olduğu yere ekleyin.

Private Sub OptionButton3_Click()
    DOLDUR
End Sub

>>Sonra da DOLDUR adlı kod'daki aşağıdaki kırmızı satırın hemen altına yeşil renklendirdiğim satırı ekleyin.

    If OptionButton1 = True And WorksheetFunction.Weekday(tarih, 2) > 5 Then GoTo 10
    If OptionButton3 = True And WorksheetFunction.Weekday(tarih, 2) < 6 Then GoTo 10

 

[sirkülasyon]

Çok sağol abim benim

 

[Ömer BARAN]

Eyvallah, kolay gelsin.
.