Kritere göre veri sayma, toplama

[kelkitli]

Değerli Dostla Selamlar,
Ekteki dosyada bir toplama işlemi yapmam gerekli Şöyleki:
E:AI aralığında 4. satırdan başlayarak dolu son satıra kadar her satır için:
E den ilk "ht"ye kadar ve her "ht" aralığı (ht den ht ye kadar) toplanacak
(mesela ht 1+2+2+2+1+1 ht=ilk 5 AJ sütununa, kalan toplam yani 4 AK sütununa aynı satıra)toplanan sayının ilk 5 saati % 50 mesai artan kısmı %100 mesai olarak işlenecek. Satırın AJ sütunundaki hücresine bütün ht aralıklarının toplam miktarı (%50 olanlar), AK hücresine de %100 olanların toplam miktarı işlenecek.

 

[Korhan Ayhan]

Selamlar,

Açıkçası sorunuzu defalarca okudum fakat anlayamadım. Dosyanız üzerinde AJ ve AK sütunlarına görnek istediğiniz sonuçlarıda yazıp tekrar foruma eklerseniz daha sağlıklı olacaktır.

 

[kelkitli]

Selamlar,
Sayın Korhan Bey teşekkür ederim. Dosya ekte.

 

[kelkitli]

Sayın Hocam, dosyada yazılı olan makro sizi yanlış yönlendirmesin. Sildim. Renklerde işlem yaparmısınız bilmiyorum. ht ler kırmızı diğer rakamlar lacivert olark ekledim. Karışıklık oluşturmasın diye.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub MESAİ_HESAPLA()
    Dim X As Long, Y As Integer
    Dim TOPLAM As Long
 
    [AJ4:AK65536].ClearContents
 
    For X = 4 To [A65536].End(3).Row
        For Y = 5 To 35
            If Cells(X, Y) <> "ht" Then
                TOPLAM = TOPLAM + Cells(X, Y)
            Else
                GoTo Hesapla
            End If
Devam1: Next
Hesapla:
    If TOPLAM > 0 Then
        If TOPLAM > 5 Then
        Cells(X, "AJ") = Cells(X, "AJ") + 5
        Cells(X, "AK") = Cells(X, "AK") + TOPLAM - 5
        Else
        Cells(X, "AJ") = Cells(X, "AJ") + TOPLAM
        End If
    End If
    TOPLAM = 0
        If Y < 35 Then
        GoTo Devam1
        Else
        GoTo Devam2
        End If
Devam2: Next
MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

 

[kelkitli]

Sayın Korhan Hocam,
Çok çok çok teşekkürler ederim. Her övgü yetersiz kalır.