AYLARA GÖRE TABLO OLUŞTURMA

Avolkan0 · 25 Kasım 2023

Merhaba
Burdaki verileri aylara göre listelemek istiyorum. Bunun pratik yöntemleri için yardımlarınızı bekliyorum. Hatta veri girdikçe tabloda güncellenirse daha iyi olur.

VERİ: https://docs.google.com/spreadsheets/d/1DDStjVJy5a49oeUdt_R6RsICfa8Uzqus_XXsKGoUBNo/edit?usp=sharing
Olmasını istediğim LİSTE: https://docs.google.com/spreadsheets/d/1pkoOEZJ7PYXPnwjn_aIsgirRlwRTvnQjLw1okiLeLWI/edit?usp=sharing

Necdet · 25 Kasım 2023

Merhaba,
Veri sekmesinde Alt Toplamlar İşinizi görür mü?

Avolkan0 · 27 Kasım 2023

Necdet' Alıntı:
Merhaba,
Veri sekmesinde Alt Toplamlar İşinizi görür mü?
Ekli dosyayı görüntüle 248008

Evet bu işimi kolaylaştırıyo ama ben aylara göre toplam almasını istiyorum ama bu şekilde her tarih değişince toplam alıyo

Necdet · 27 Kasım 2023

Merhaba,
Linkteki çözüm işinize yarar mı? Pivot Table ile yapılmıştır.
Sizin önerdiğiniz gibi bir görünüme erişmek için fazla işlem gerekiyor. Özellikle Yeni satır eklemelerinde vs vs vs.

Dosyaya Buradan Erişiniz

Korhan Ayhan · 27 Kasım 2023

Bir yardımcı sütun kullanarak ALTTOPLAM özelliğini kullanabilirsiniz.

Harici Link (Silinebilir) ; https://dosya.co/4ibua7g5wtk2/VERİ.xlsx.html

Avolkan0 · 27 Kasım 2023

Daha pratik yolu yoksa bu şekilde de işime yardım eder. Teşekkürler

Korhan Ayhan · 27 Kasım 2023

Paylaştığım örnek dosyaya bir sayfa daha ekleyerek üstte ki mesajımı güncelledim. Bu sayfada ÖZET TABLO uygulaması var. Necdet beyin paylaşımından farkı ise görünümüdür..

Avolkan0 · 29 Kasım 2023

Teşekkür ederim
Elle tek tek uğraşmaktansa bu şekilde yapmak daha kolay tabi.

Necdet · 30 Kasım 2023

Merhaba,
Sanırım çözümlerden pek hoşnut olmadınız, ben de sizin istediğiniz gibi olsun istedim.
Verinin B2 hücresinden başladığını düşünerek yazıldı kodlar.

Dosya Linki

Kod:

Sub AYLIK_TOPLAM_AL()

Dim i   As Long, _
    j   As Long, _
    lr  As Long, _
    rng As Range

Application.ScreenUpdating = False

On Error Resume Next

Range("B2:B" & Cells(Rows.Count, "B").End(3).Row + 5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

For i = Cells(Rows.Count, "B").End(3).Row + 1 To 3 Step -1
    If Not Format(Cells(i, "B"), "yymm") = Format(Cells(i - 1, "B"), "yymm") Then
        Rows(i).Insert
        With Range("C" & i)
            .Value = Format(Cells(i - 1, "B"), "yyyy mmmm") & " TOPLAMI"
            .Font.Bold = True
            .HorizontalAlignment = xlRight
            .IndentLevel = 1
            .Offset(0, 1).Font.Bold = True
        End With
    End If
Next i

lr = Cells(Rows.Count, "D").End(3).Row + 1

i = 2
Do
    j = Range("D" & i).End(xlDown).Row
    Range("D" & j + 1) = "=SUM(D" & i & ":D" & j & ")"
    i = j + 2
Loop Until i > lr

Set rng = Range("D2:D" & i).SpecialCells(xlCellTypeFormulas, 23)

With Range("D" & i)
    .Formula = "=SUM(" & rng.Address & ")"
    .Font.Bold = True
    With .Offset(0, -1)
        .Value = "GENEL TOPLAM"
        .Font.Bold = True
        .HorizontalAlignment = xlRight
        .IndentLevel = 1
    End With
End With
        
Application.ScreenUpdating = True

End Sub

Avolkan0 · 8 Aralık 2023

Necdet' Alıntı:

Merhaba,
Sanırım çözümlerden pek hoşnut olmadınız, ben de sizin istediğiniz gibi olsun istedim.
Verinin B2 hücresinden başladığını düşünerek yazıldı kodlar.

Dosya Linki

Kod:

Sub AYLIK_TOPLAM_AL()

Dim i   As Long, _
    j   As Long, _
    lr  As Long, _
    rng As Range

Application.ScreenUpdating = False

On Error Resume Next

Range("B2:B" & Cells(Rows.Count, "B").End(3).Row + 5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

For i = Cells(Rows.Count, "B").End(3).Row + 1 To 3 Step -1
    If Not Format(Cells(i, "B"), "yymm") = Format(Cells(i - 1, "B"), "yymm") Then
        Rows(i).Insert
        With Range("C" & i)
            .Value = Format(Cells(i - 1, "B"), "yyyy mmmm") & " TOPLAMI"
            .Font.Bold = True
            .HorizontalAlignment = xlRight
            .IndentLevel = 1
            .Offset(0, 1).Font.Bold = True
        End With
    End If
Next i

lr = Cells(Rows.Count, "D").End(3).Row + 1

i = 2
Do
    j = Range("D" & i).End(xlDown).Row
    Range("D" & j + 1) = "=SUM(D" & i & ":D" & j & ")"
    i = j + 2
Loop Until i > lr

Set rng = Range("D2:D" & i).SpecialCells(xlCellTypeFormulas, 23)

With Range("D" & i)
    .Formula = "=SUM(" & rng.Address & ")"
    .Font.Bold = True
    With .Offset(0, -1)
        .Value = "GENEL TOPLAM"
        .Font.Bold = True
        .HorizontalAlignment = xlRight
        .IndentLevel = 1
    End With
End With
       
Application.ScreenUpdating = True

End Sub

Çok teşekkür ederim. Zaman ayırıp uğraşmışsınız.
İstediğim şey buydu.

Ek bişey daha istesem sizden. Mesela 2023 Kasım Toplamı yazıyorya, bunun ve diğer toplamların altına bi tane boş satır ekleyecek şekilde güncelleme yapabilirmisiniz?

Necdet · 8 Aralık 2023

Merhaba,
Dosya değil kodları ekliyorum.
Yarın bir gün 2 değil şu kadar boş satır versin diyebilirsiniz.
Ben de parametrik yaptım. N1 hücresine yazdığınız rakam kadar satır açar. Yazsmazsanız 1 satır açar ve toplam satırını yazar.

Kod:

Sub AYLIK_TOPLAM_AL()

Dim i   As Long, _
    j   As Long, _
    lr  As Long, _
    rng As Range, _
    ara As Integer

Application.ScreenUpdating = False
ara = [N1]
If ara = 0 Then ara = 1
On Error Resume Next

Range("B2:B" & Cells(Rows.Count, "C").End(3).Row + 5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

For i = Cells(Rows.Count, "B").End(3).Row + 1 To 3 Step -1
    If Not Format(Cells(i, "B"), "yymm") = Format(Cells(i - 1, "B"), "yymm") Then
        Rows(i & ":" & i + ara - 1).Insert
        With Range("C" & i)
            .Value = BKH(Format(Cells(i - 1, "B"), "yyyy mmmm") & " TOPLAMI")
            .Font.Bold = True
            .HorizontalAlignment = xlRight
            .IndentLevel = 1
            .Offset(0, 1).Font.Bold = True
        End With
    End If
Next i

lr = Cells(Rows.Count, "D").End(3).Row + 1

i = 2
Do
    j = Range("D" & i).End(xlDown).Row
    Range("D" & j + 1) = "=SUM(D" & i & ":D" & j & ")"
    i = j + ara + 1
Loop Until i > lr

Set rng = Range("D2:D" & i).SpecialCells(xlCellTypeFormulas, 23)

With Range("D" & i)
    .Formula = "=SUM(" & rng.Address & ")"
    .Font.Bold = True
    With .Offset(0, -1)
        .Value = "GENEL TOPLAM"
        .Font.Bold = True
        .HorizontalAlignment = xlRight
        .IndentLevel = 1
    End With
End With
        
Application.ScreenUpdating = True

End Sub

Function BKH(Sozcuk As String, Optional Tip As Integer = 2) As String

    'Tip    1. Küçük Harf
    '       2. Büyük Harf
    '       3. Yazım Düzeni
    
    If Tip = 1 Then
        BKH = Evaluate("=LOWER(" & """" & Sozcuk & """" & ")")
    ElseIf Tip = 2 Then
        BKH = Evaluate("=UPPER(" & """" & Sozcuk & """" & ")")
    Else
        BKH = Application.WorksheetFunction.Proper(Sozcuk)
    End If
    
End Function

Avolkan0 · 9 Aralık 2023

Necdet' Alıntı:

Merhaba,
Dosya değil kodları ekliyorum.
Yarın bir gün 2 değil şu kadar boş satır versin diyebilirsiniz.
Ben de parametrik yaptım. N1 hücresine yazdığınız rakam kadar satır açar. Yazsmazsanız 1 satır açar ve toplam satırını yazar.

Kod:

Sub AYLIK_TOPLAM_AL()

Dim i   As Long, _
    j   As Long, _
    lr  As Long, _
    rng As Range, _
    ara As Integer

Application.ScreenUpdating = False
ara = [N1]
If ara = 0 Then ara = 1
On Error Resume Next

Range("B2:B" & Cells(Rows.Count, "C").End(3).Row + 5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

For i = Cells(Rows.Count, "B").End(3).Row + 1 To 3 Step -1
    If Not Format(Cells(i, "B"), "yymm") = Format(Cells(i - 1, "B"), "yymm") Then
        Rows(i & ":" & i + ara - 1).Insert
        With Range("C" & i)
            .Value = BKH(Format(Cells(i - 1, "B"), "yyyy mmmm") & " TOPLAMI")
            .Font.Bold = True
            .HorizontalAlignment = xlRight
            .IndentLevel = 1
            .Offset(0, 1).Font.Bold = True
        End With
    End If
Next i

lr = Cells(Rows.Count, "D").End(3).Row + 1

i = 2
Do
    j = Range("D" & i).End(xlDown).Row
    Range("D" & j + 1) = "=SUM(D" & i & ":D" & j & ")"
    i = j + ara + 1
Loop Until i > lr

Set rng = Range("D2:D" & i).SpecialCells(xlCellTypeFormulas, 23)

With Range("D" & i)
    .Formula = "=SUM(" & rng.Address & ")"
    .Font.Bold = True
    With .Offset(0, -1)
        .Value = "GENEL TOPLAM"
        .Font.Bold = True
        .HorizontalAlignment = xlRight
        .IndentLevel = 1
    End With
End With
       
Application.ScreenUpdating = True

End Sub

Function BKH(Sozcuk As String, Optional Tip As Integer = 2) As String

    'Tip    1. Küçük Harf
    '       2. Büyük Harf
    '       3. Yazım Düzeni
   
    If Tip = 1 Then
        BKH = Evaluate("=LOWER(" & """" & Sozcuk & """" & ")")
    ElseIf Tip = 2 Then
        BKH = Evaluate("=UPPER(" & """" & Sozcuk & """" & ")")
    Else
        BKH = Application.WorksheetFunction.Proper(Sozcuk)
    End If
   
End Function

Tekrardan çok çok teşekkür ederim.
Tam istediğim olmuş.
Çok sağolun. Elleriniz dert görmesin

AYLARA GÖRE TABLO OLUŞTURMA

Avolkan0

Necdet

Moderatör

Avolkan0

Necdet

Moderatör

Korhan Ayhan

Administrator

Ekli dosyalar

Avolkan0

Korhan Ayhan

Administrator

Avolkan0

Necdet

Moderatör

Ekli dosyalar

Avolkan0

Necdet

Moderatör

Avolkan0