Günlük veriyi aylık veriye dönüştürme

Gamma · 24 Ağustos 2021

Merhaba,
Bir sayfada ilk sütunum günlük tarih, diğer sütunlarda da her elemana ait günlük veriler var.
Benim ihtiyacım olan listelenen tarihlerdeki her ayın son gününde (bu bazen ayın 31'i bazen 27'si bazen 22'si olabiliyor) o aya ait değerlerin toplamının alınarak yeni bir sayfaya aylık veri olarak aktarmak.

Tarih............... M...... E........F........K
01.02.2021..........1..........2..........1..........6
02.02.2021..........4..........8..........2..........5
26.02.2021..........3..........5..........8..........1
01.03.2021..........1..........1..........1..........3
02.03.2021..........5..........1..........3..........7
31.03.2021..........1..........2..........2..........6

cevap
Tarih............... M...... E........F........K
26.02.2021..........8........15.......11........12
31.03.2021..........7..........4..........6........16

çok teşekkür ederim.

GursoyC · 24 Ağustos 2021

Yardımcı bir sütuna (örneğin D sütununa) =AY(A2) formülünü uyguladıktan sonra;
=ETOPLA(D:D;2;B:B) formülü size B sütununda yer alan M kişisine ait (örneğin) şubat ayı toplamını verecektir.
Örnek dosya eklerseniz daha ayrıntılı yardımcı olunabilir.

Gamma · 24 Ağustos 2021

unlimitted' Alıntı:
Yardımcı bir sütuna (örneğin D sütununa) =AY(A2) formülünü uyguladıktan sonra;
=ETOPLA(D:D;2;B:B) formülü size B sütununda yer alan M kişisine ait (örneğin) şubat ayı toplamını verecektir.
Örnek dosya eklerseniz daha ayrıntılı yardımcı olunabilir.

çok teşekkür ederim. Ancak sanırım bu formülde tüm 2 ya da diğer ayların toplamı alınıyor. Benim tarih listemde 2009'dan 2019'a kadar toplam 120 adet her aydan var o nedenle bir ayarlama daha yapmak gerekiyor sanırım.

Gamma · 24 Ağustos 2021

unlimitted' Alıntı:
Yardımcı bir sütuna (örneğin D sütununa) =AY(A2) formülünü uyguladıktan sonra;
=ETOPLA(D:D;2;B:B) formülü size B sütununda yer alan M kişisine ait (örneğin) şubat ayı toplamını verecektir.
Örnek dosya eklerseniz daha ayrıntılı yardımcı olunabilir.

çoketopla( ) fonksiyonuna yılı da bir kriter olarak eklediğimde oldu tekrar çok teşekkür ederim.

GursoyC · 24 Ağustos 2021

Rica ederim, iyi çalışmalar.

veyselemre · 24 Ağustos 2021

Kod:

Sub test()
    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%

    Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, 5).Value
    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To 5)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then yData(sira, 1) = data(i, 1)
            For ii = 2 To 5
                yData(sira, ii) = yData(sira, ii) + data(i, ii)
            Next ii
        Next i
        Range("H:L").ClearContents
        Range("H1").Resize(, 5).Value = Range("A1").Resize(, 5).Value
        Range("H2").Resize(say, 5).Value = yData
    End With
End Sub

Gamma · 24 Ağustos 2021

çoketopla( ) fonksiyonundaki sorun değerlerin olmadığı aylarda 0 toplamını vermesi. O ayların boş olarak görünmesi için ne yapmak gerekir acaba?

Gamma · 24 Ağustos 2021

veyselemre' Alıntı:

Kod:

Sub test()
    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%

    Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, 5).Value
    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To 5)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then yData(sira, 1) = data(i, 1)
            For ii = 2 To 5
                yData(sira, ii) = yData(sira, ii) + data(i, ii)
            Next ii
        Next i
        Range("H:L").ClearContents
        Range("H1").Resize(, 5).Value = Range("A1").Resize(, 5).Value
        Range("H2").Resize(say, 5).Value = yData
    End With
End Sub

Harika çalışıyor çok teşekkür ederim.
Acaba veriyi yeni açacağı sayfaya yazdırması için kodda nasıl bir ekleme yapılabilir ?

Bir de bunun aynısını ay toplamı olarak değil de ayın son günkü değerini gösterir şekilde de modifiye ederim diye düşünmüştüm (o da ayrıca lazım olacak) ama koda bakınca benim altından kalkabileceğim bir şey gibi gözükmüyor. Bu da ayrıca mümkün olabilir mi acaba?
Eğer bunu da istersem fazla ileri gitmiş olur muyum?
İlginiz ve yardımlarınız için tekrar çok çok teşekkür ederim.

Haluk · 24 Ağustos 2021

Her yılın verisi ayrı sayfada olsa, sayfalarda Pivot Tablo ile kolayca yapılabilirdi....

.

Gamma · 24 Ağustos 2021

veyselemre' Alıntı:

Kod:

Sub test()
    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%

    Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, 5).Value
    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To 5)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then yData(sira, 1) = data(i, 1)
            For ii = 2 To 5
                yData(sira, ii) = yData(sira, ii) + data(i, ii)
            Next ii
        Next i
        Range("H:L").ClearContents
        Range("H1").Resize(, 5).Value = Range("A1").Resize(, 5).Value
        Range("H2").Resize(say, 5).Value = yData
    End With
End Sub

Tekrar merhaba.
Bu kod az sayıda data için harika çalışıyor. Ama 2570 satır, 170 sütünlu bir veri için çalıştırdım

yData(sira, ii) = yData(sira, ii) + data(i, ii)

sütünunda hata veriyor. Ama data satırını ve sütununu azalttığımda tam istediğim gibi çalışıyor.
Acaba neden olabilir?

Teşekkür ederim.

Haluk · 24 Ağustos 2021

Aşağıdaki resimde belirtildiği gibi Pivot Tablo işinize yararsa, linkteki dosyayı inceleyebilirsiniz....

Dosya:

Book1.xlsx dosyasını indir - download

Book1.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s5.dosya.tc

Gamma · 24 Ağustos 2021

Haluk' Alıntı:
Aşağıdaki resimde belirtildiği gibi Pivot Tablo işinize yararsa, linkteki dosyayı inceleyebilirsiniz....

Dosya:

Book1.xlsx dosyasını indir - download

Book1.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s5.dosya.tc

Ekli dosyayı görüntüle 229647

Çok teşekkür ederim

veyselemre · 25 Ağustos 2021

Kod:

Sub herAyinToplamDegerleriniGoster()

    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%, sutSay%

    Dim kynkSh As Worksheet
    Dim hdfSh As Worksheet

    Set kynkSh = Sheets("Sheet1")
    Set hdfSh = Sheets("Sheet2")

    sutSay = kynkSh.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = kynkSh.Range("A2:A" & kynkSh.Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, sutSay).Value

    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To sutSay)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then yData(sira, 1) = data(i, 1)
            For ii = 2 To sutSay
                yData(sira, ii) = yData(sira, ii) + data(i, ii)
            Next ii
        Next i
        hdfSh.Cells.ClearContents
        hdfSh.Range("A1").Resize(, sutSay).Value = kynkSh.Range("A1").Resize(, sutSay).Value
        hdfSh.Range("A2").Resize(say, sutSay).Value = yData
    End With

End Sub

Kod:

Sub herAyinSonGunDegerleriniGoster()

    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%, sutSay%

    Dim kynkSh As Worksheet
    Dim hdfSh As Worksheet

    Set kynkSh = Sheets("Sheet1")
    Set hdfSh = Sheets("Sheet2")

    sutSay = kynkSh.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = kynkSh.Range("A2:A" & kynkSh.Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, sutSay).Value

    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To sutSay)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then
                yData(sira, 1) = data(i, 1)
                For ii = 2 To sutSay
                    yData(sira, ii) = data(i, ii)
                Next ii
            End If
        Next i
        hdfSh.Cells.ClearContents
        hdfSh.Range("A1").Resize(, sutSay).Value = kynkSh.Range("A1").Resize(, sutSay).Value
        hdfSh.Range("A2").Resize(say, sutSay).Value = yData
    End With

End Sub

Gamma · 25 Ağustos 2021

veyselemre' Alıntı:

Kod:

Sub herAyinToplamDegerleriniGoster()

    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%, sutSay%

    Dim kynkSh As Worksheet
    Dim hdfSh As Worksheet

    Set kynkSh = Sheets("Sheet1")
    Set hdfSh = Sheets("Sheet2")

    sutSay = kynkSh.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = kynkSh.Range("A2:A" & kynkSh.Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, sutSay).Value

    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To sutSay)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then yData(sira, 1) = data(i, 1)
            For ii = 2 To sutSay
                yData(sira, ii) = yData(sira, ii) + data(i, ii)
            Next ii
        Next i
        hdfSh.Cells.ClearContents
        hdfSh.Range("A1").Resize(, sutSay).Value = kynkSh.Range("A1").Resize(, sutSay).Value
        hdfSh.Range("A2").Resize(say, sutSay).Value = yData
    End With

End Sub

Kod:

Sub herAyinSonGunDegerleriniGoster()

    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%, sutSay%

    Dim kynkSh As Worksheet
    Dim hdfSh As Worksheet

    Set kynkSh = Sheets("Sheet1")
    Set hdfSh = Sheets("Sheet2")

    sutSay = kynkSh.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = kynkSh.Range("A2:A" & kynkSh.Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, sutSay).Value

    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To sutSay)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then
                yData(sira, 1) = data(i, 1)
                For ii = 2 To sutSay
                    yData(sira, ii) = data(i, ii)
                Next ii
            End If
        Next i
        hdfSh.Cells.ClearContents
        hdfSh.Range("A1").Resize(, sutSay).Value = kynkSh.Range("A1").Resize(, sutSay).Value
        hdfSh.Range("A2").Resize(say, sutSay).Value = yData
    End With

End Sub

Hemen uygulayacağım tekrar çok çok teşekkür ederim

Gamma · 25 Ağustos 2021

veyselemre' Alıntı:

Kod:

Sub herAyinToplamDegerleriniGoster()

    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%, sutSay%

    Dim kynkSh As Worksheet
    Dim hdfSh As Worksheet

    Set kynkSh = Sheets("Sheet1")
    Set hdfSh = Sheets("Sheet2")

    sutSay = kynkSh.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = kynkSh.Range("A2:A" & kynkSh.Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, sutSay).Value

    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To sutSay)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then yData(sira, 1) = data(i, 1)
            For ii = 2 To sutSay
                yData(sira, ii) = yData(sira, ii) + data(i, ii)
            Next ii
        Next i
        hdfSh.Cells.ClearContents
        hdfSh.Range("A1").Resize(, sutSay).Value = kynkSh.Range("A1").Resize(, sutSay).Value
        hdfSh.Range("A2").Resize(say, sutSay).Value = yData
    End With

End Sub

Kod:

Sub herAyinSonGunDegerleriniGoster()

    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%, sutSay%

    Dim kynkSh As Worksheet
    Dim hdfSh As Worksheet

    Set kynkSh = Sheets("Sheet1")
    Set hdfSh = Sheets("Sheet2")

    sutSay = kynkSh.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = kynkSh.Range("A2:A" & kynkSh.Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, sutSay).Value

    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To sutSay)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then
                yData(sira, 1) = data(i, 1)
                For ii = 2 To sutSay
                    yData(sira, ii) = data(i, ii)
                Next ii
            End If
        Next i
        hdfSh.Cells.ClearContents
        hdfSh.Range("A1").Resize(, sutSay).Value = kynkSh.Range("A1").Resize(, sutSay).Value
        hdfSh.Range("A2").Resize(say, sutSay).Value = yData
    End With

End Sub

Neden olduğunu anlayamadım ama
Sub herAyinToplamDegerleriniGoster()
birinci makro data satır ve sütunları azken harika çalışıyor. Ama 170 sütun 2576 satırda aşağıdaki satırda hata uyarısı veriyor:
yData(sira, ii) = yData(sira, ii) + data(i, ii)

Hem satırları hem de sütunları silip daha küçük veri ile çalıştığımda hiç bir sorun olmuyor.

veyselemre · 25 Ağustos 2021

Normalde hata vermemesi gerekir. Hata veren örneği ekleyin. Toplama işleminde hata verdiğine göre tabloda sayısal alan olması gereken yerde sayısal olmayan bir veri olabilir.

Gamma · 25 Ağustos 2021

veyselemre' Alıntı:
Normalde hata vermemesi gerekir. Hata veren örneği ekleyin. Toplama işleminde hata verdiğine göre tabloda sayısal alan olması gereken yerde sayısal olmayan bir veri olabilir.

evet haklısınız bu mümkün hemen bakayım. araya hatalı olarak sayı dışı ifadeler varsa çıkarıp bir daha deneyeceğim

Gamma · 25 Ağustos 2021

Gözle taradım ama sanırım bu şekilde metin ya da sayı değeri dışı hücreleri tespit etmek çok mümkün değil ama yine de bir yol bulmaya çalışıyorum

veyselemre · 25 Ağustos 2021

Hata verdiği zaman duracaktır ilgili veriyi inceleyin.

Kod:

Sub herAyinToplamDegerleriniGoster()

    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%, sutSay%

    Dim kynkSh As Worksheet
    Dim hdfSh As Worksheet

    Set kynkSh = Sheets("Sheet1")
    Set hdfSh = Sheets("Sheet2")

    sutSay = kynkSh.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = kynkSh.Range("A2:A" & kynkSh.Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, sutSay).Value

    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To sutSay)


    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then yData(sira, 1) = data(i, 1)
            For ii = 2 To sutSay
                On Error Resume Next
                yData(sira, ii) = yData(sira, ii) + data(i, ii)
                If Err Then
                    Err.Clear
                    MsgBox data(i, ii) & vbCr & i & ".satır" & vbCr & ii & ".sütun"
                    Cells(i, ii).Select
                    On Error GoTo 0
                    Exit Sub
                End If
            Next ii
        Next i
        hdfSh.Cells.ClearContents
        hdfSh.Range("A1").Resize(, sutSay).Value = kynkSh.Range("A1").Resize(, sutSay).Value
        hdfSh.Range("A2").Resize(say, sutSay).Value = yData
    End With

End Sub

Gamma · 25 Ağustos 2021

veyselemre' Alıntı:

Hata verdiği zaman duracaktır ilgili veriyi inceleyin.

Kod:

Sub herAyinToplamDegerleriniGoster()

    Dim rng As Range
    Dim mx As Date, mn As Date
    Dim data, yData(), krt$
    Dim i&, say&, sira&, ii%, sutSay%

    Dim kynkSh As Worksheet
    Dim hdfSh As Worksheet

    Set kynkSh = Sheets("Sheet1")
    Set hdfSh = Sheets("Sheet2")

    sutSay = kynkSh.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = kynkSh.Range("A2:A" & kynkSh.Cells(Rows.Count, 1).End(3).Row)
    data = rng.Resize(, sutSay).Value

    mx = WorksheetFunction.Max(rng)
    mn = WorksheetFunction.Min(rng)

    ReDim yData(1 To DateDiff("m", mn, mx) + 1, 1 To sutSay)


    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = Format(data(i, 1), "yyyymm")
            If Not .exists(krt) Then
                say = say + 1
                .Item(krt) = say
            End If
            sira = .Item(krt)
            If yData(sira, 1) < data(i, 1) Then yData(sira, 1) = data(i, 1)
            For ii = 2 To sutSay
                On Error Resume Next
                yData(sira, ii) = yData(sira, ii) + data(i, ii)
                If Err Then
                    Err.Clear
                    MsgBox data(i, ii) & vbCr & i & ".satır" & vbCr & ii & ".sütun"
                    Cells(i, ii).Select
                    On Error GoTo 0
                    Exit Sub
                End If
            Next ii
        Next i
        hdfSh.Cells.ClearContents
        hdfSh.Range("A1").Resize(, sutSay).Value = kynkSh.Range("A1").Resize(, sutSay).Value
        hdfSh.Range("A2").Resize(say, sutSay).Value = yData
    End With

End Sub

Hata verdiği durumlar şöyle:

Tarih............... M...... E........F........K
01.02.2021..........1..........2........ .........6
02.02.2021..........4..........8........ .........5
26.02.2021..........3..........5..........8..........1
01.03.2021..........1..........1..........1..........3
02.03.2021..........5..........1..........3..........7
31.03.2021..........1........ .......2..........6

Örneğin yukarıda :
- F için ilk iki gün veri yok
- ya da E için son gün veri yok

o noktalara gelip duruyor program. Kontrol ettim tüm tablodaki değerler tam dolu olunca hiç sorun olmuyor ama eksik veri olunca takılıyor.

Günlük veriyi aylık veriye dönüştürme

Gamma

GursoyC

Gamma

Gamma

GursoyC

veyselemre

Özel Üye

Gamma

Gamma

Haluk

Özel Üye

Gamma

Haluk

Özel Üye

Book1.xlsx dosyasını indir - download

Gamma

Book1.xlsx dosyasını indir - download

veyselemre

Özel Üye

Gamma

Gamma

veyselemre

Özel Üye

Gamma

Gamma

veyselemre

Özel Üye

Gamma