Soru ay ay yıllık toplam almak

[ozcanya]

Arkadaşlar her ay yapmış olduğum nöbet listesinde, nöbet tutan arkadaşların fazla mesaileri ait olan aya göre yıllık toplam sayfasına ay ay toplamak istiyorum. bunu makro ile yapabilir miyiz? Örnek dosyam ekte teşekkür ederim.
fazla mesailer Nöbet listesi 1 de "A36" da başlıyor

 

[ozcanya]

Arkadaşlar konum güncel sizden yardım rica ediyorum

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[ozcanya]

Sayın "Muygun bey" teşekkür bir borç bilirim.İlgi ve alakanıza teşekkür ederim.Tam istediğim gibi

 

[Necdet]

ilgi=alaka

 

[ozcanya]

ilgi=alaka

Mesaj alındı üstat

 

[Necdet]

Mesaj alındı üstat

 

[ozcanya]

Merhaba;
Eki deneyin.
İyi çalışmalar.

sayın muygun bey ay ve yıl değiştiği zaman geride kalan ayı siliyor.Yani ocak ayı çalışması yapıyorum daha sonra sayfayı kopyalayıp şubat yaptığımda ocak verilerini siliyor.sizden ricam bir bakabilir misiniz?

 

[Ziynettin]

Alternatif çalışma.

Sub test()
Set s1 = Sheets("nöbet listesi 1")
a = s1.[A2:J35].Value
Set dc = CreateObject("scripting.dictionary")
Set dz = CreateObject("scripting.dictionary")
Set ds = CreateObject("scripting.dictionary")

For i = 2 To UBound(a) - 3
    If (a(i, 1)) <> "" Then
        ay = Format(a(i, 1), "mmmm")
        For j = 5 To UBound(a, 2)
            k = a(1, j) & "|" & ay
            If IsNumeric(a(i, j)) Then
                dz(k) = a(UBound(a), j)
                dc(k) = dc(k) + (a(i, j))
                ds(k) = dc(k) - dz(k)
            End If
        Next j
    End If
Next i

Set s2 = Sheets("yıllık toplamlar")

For y = 1 To 12
    s2.Cells(2, y + 1) = Format("1." & y, "mmmm")
Next y

sut = s2.Rows(2).Find(ay, , , , xlByColumns, xlNext).Column
son = s2.Columns(1).Find("*", , , , xlByRows, xlPrevious).Row

a = s2.Range("A2:M" & son).Value

ReDim b(1 To UBound(a) - 1, 1 To 1)

For i = 2 To UBound(a)
    b(i - 1, 1) = ds(a(i, 1) & "|" & ay)
Next i

s2.Cells(3, sut).Resize(UBound(a) - 1) = b
MsgBox "İşlem bitti.", vbInformation
End Sub

 

[ozcanya]

Alternatif çalışma.

Sub test()
Set s1 = Sheets("nöbet listesi 1")
a = s1.[A2:J35].Value
Set dc = CreateObject("scripting.dictionary")
Set dz = CreateObject("scripting.dictionary")
Set ds = CreateObject("scripting.dictionary")

For i = 2 To UBound(a) - 3
    If (a(i, 1)) <> "" Then
        ay = Format(a(i, 1), "mmmm")
        For j = 5 To UBound(a, 2)
            k = a(1, j) & "|" & ay
            If IsNumeric(a(i, j)) Then
                dz(k) = a(UBound(a), j)
                dc(k) = dc(k) + (a(i, j))
                ds(k) = dc(k) - dz(k)
            End If
        Next j
    End If
Next i

Set s2 = Sheets("yıllık toplamlar")

For y = 1 To 12
    s2.Cells(2, y + 1) = Format("1." & y, "mmmm")
Next y

sut = s2.Rows(2).Find(ay, , , , xlByColumns, xlNext).Column
son = s2.Columns(1).Find("*", , , , xlByRows, xlPrevious).Row

a = s2.Range("A2:M" & son).Value

ReDim b(1 To UBound(a) - 1, 1 To 1)

For i = 2 To UBound(a)
    b(i - 1, 1) = ds(a(i, 1) & "|" & ay)
Next i

s2.Cells(3, sut).Resize(UBound(a) - 1) = b
MsgBox "İşlem bitti.", vbInformation
End Sub

Öncelikle teşekkür ederim. Yıllık toplam sayfasındaki ayları değiştiriyor. Nisan ayından başlatıyor.

 

[ozcanya]

Alternatif çalışma.

Sub test()
Set s1 = Sheets("nöbet listesi 1")
a = s1.[A2:J35].Value
Set dc = CreateObject("scripting.dictionary")
Set dz = CreateObject("scripting.dictionary")
Set ds = CreateObject("scripting.dictionary")

For i = 2 To UBound(a) - 3
    If (a(i, 1)) <> "" Then
        ay = Format(a(i, 1), "mmmm")
        For j = 5 To UBound(a, 2)
            k = a(1, j) & "|" & ay
            If IsNumeric(a(i, j)) Then
                dz(k) = a(UBound(a), j)
                dc(k) = dc(k) + (a(i, j))
                ds(k) = dc(k) - dz(k)
            End If
        Next j
    End If
Next i

Set s2 = Sheets("yıllık toplamlar")

For y = 1 To 12
    s2.Cells(2, y + 1) = Format("1." & y, "mmmm")
Next y

sut = s2.Rows(2).Find(ay, , , , xlByColumns, xlNext).Column
son = s2.Columns(1).Find("*", , , , xlByRows, xlPrevious).Row

a = s2.Range("A2:M" & son).Value

ReDim b(1 To UBound(a) - 1, 1 To 1)

For i = 2 To UBound(a)
    b(i - 1, 1) = ds(a(i, 1) & "|" & ay)
Next i

s2.Cells(3, sut).Resize(UBound(a) - 1) = b
MsgBox "İşlem bitti.", vbInformation
End Sub

Hocam Şubat ayı verileri gönderirken yanlış veri gönderiyor. Rica etsem bakabilirmisiniz ?

 

[Ziynettin]

Hocam Şubat ayı verileri gönderirken yanlış veri gönderiyor. Rica etsem bakabilirmisiniz ?

A3:A33 aralığında dolu hücrelere göre veri alınıyor. Şubat ayı seçildiğinde tablonuz A3:A31 aralığında oluşuyor buna göre kontrol ediniz.

 

[ozcanya]

A3:A33 aralığında dolu hücrelere göre veri alınıyor. Şubat ayı seçildiğinde tablonuz A3:A31 aralığında oluşuyor buna göre kontrol ediniz.

Çok teşekkür ederim.

 

[ozcanya]

Merhaba;
Eki deneyin.
İyi çalışmalar.

sayın muygun bey ay ve yıl değiştiği zaman geride kalan ayı siliyor.
Yani ocak ayı çalışması yapıyorum daha sonra sayfayı kopyalayıp şubat yaptığımda ocak verilerini siliyor. sizden ricam bir bakabilir misiniz?

 

[muygun]

Merhaba;
Sayfanın silinerek yenilenmesi işlemleri değiştirir.
Eki deneyin.
İyi çalışmalar.

 

[ozcanya]

Merhaba;
Sayfanın silinerek yenilenmesi işlemleri değiştirir.
Eki deneyin.
İyi çalışmalar.

Sayın muygun bey bu çalışmamızı örnek olarak;
Ahmet için E36,
Mehmet için F36,
Ali için G36,
veli için H36 ......
bu hücrelerdeki bilgileri alacak şekilde düzenleyebilir miyiz? bu benim için yerli olacak
not: ay değişikliğinde diğer bilgiler silinmesin

 

[muygun]

Merhaba;
Datalarınızı önce kaydet , sonra aydeğiştir sonra tekrar kaydet buradan rapor çıkar yerine;
Her ay için bir sayfa oluşturun.
Bu sayfalardan veriyi (makroya dahi gerek kalmaksızın) formüllerle alırsınız.
Eki inceleyin.
iyi çalışmalar.