Aylara Göre Kişilerin toplam aidat dağılımı

[Mdemir63]

@Ziynettin Hocam elinize sağlık alternatif için.
Birde gelen rakamlar sayı formatında olabilir mi?

Saygılar

 

[assenucler]

Sayın Çıtır,

Emeğiniz için teşekkürler.
Saygılar,

 

[Mdemir63]

Selamlar
Sayın @Ziynettin hocam rakamların sayı formatına çevirmek için kodlarda nasıl bir değişiklik gerekir?
Saygılar

 

[assenucler]

Sayın @ Mdemir63,

B - N sütunlarını seçip, sağ tıkla Hücre Biçimlendir - Sayı - Tamam ile sorunu aştım.

 

[Mdemir63]

Sayın @ Mdemir63,

B - N sütunlarını seçip, sağ tıkla Hücre Biçimlendir - Sayı - Tamam ile sorunu aştım.

Sayın @assenucler daha önce onu yaptım. ama tekrar kod çalıştığında eski haline geliyor.
Kodlarda CDbl yapmak gerekli sanırım ama nereye işte orada takılıyorum.

 

[Ziynettin]

Sayı biçimi;

say=say-3 satırın altına aşağıdaki kod satırlarını ekleyin.

sh.[B3].Resize(say, 13).NumberFormat = "#,##0.00" sh.[N3].Offset(say + 2).NumberFormat = "#,##0.00"

 

[Mdemir63]

Hocam teşekkürler
Saygılar

 

[assenucler]

Teşekkürler üstadım.
Sağ olun, var olun.

 

[Mdemir63]

Tekrar merhabalar
Sayın @çıtır hocam Sayın @Ziynettin hocam
icmal sayfasında aktarılan kısımların arasındaki boşluğu kaldırdığımızda, kodlarda nasıl bir değişiklik yapmamız gerekir.

Saygılar

 

[Mdemir63]

Hocam sadece step kısmını kaldırıp denedim olmadı.

 

[Korhan Ayhan]

"icmal" sayfası nasıl görünmeli?

 

[Mdemir63]

Selamlar
Korhan hocam
resimdeki gibi

 

[Korhan Ayhan]

Ay isimleri kaçıncı satırdan başlasın?

 

[Mdemir63]

3. satırdan hocam

 

[Ziynettin]

Dosyanız ekte..

 

[Mdemir63]

@Ziynettin hocam elinize sağlık.
Teşekkür ederim.

Saygılar

 

[Korhan Ayhan]

Alternatif olsun;

Option Explicit

Private Sub CommandButton1_Click()
    Dim Yil As Variant, S1 As Worksheet, S2 As Worksheet
    Dim Dizi As Object, Son As Long, Veri As Variant
    Dim X As Long, Y As Byte, Say As Long, Zaman As Double
    
    Yil = Application.InputBox("Lütfen yılı giriniz.", "YIL GİRİŞİ", Year(Now))
    
    If Yil = False Or Yil = "" Or Len(Yil) <> 4 Then Exit Sub
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("aidat")
    Set S2 = Sheets("icmal")
    Set Dizi = CreateObject("Scripting.Dictionary")
        
    S2.Cells.Clear
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    Veri = S1.Range("B2:D" & Son).Value
    
    ReDim Liste(1 To Son, 1 To 14)
    
    For X = LBound(Veri) To UBound(Veri)
        If Year(Veri(X, 2)) = Val(Yil) Then
            If Not Dizi.Exists(Veri(X, 1)) Then
                Say = Say + 1
                Dizi.Add Veri(X, 1), Say
                
                Liste(Say, 1) = Veri(X, 1)
                
                For Y = 2 To 14
                    If Month(Veri(X, 2)) = Y - 1 Then
                        Liste(Say, Y) = IIf(Veri(X, 3) = Empty, 0, Veri(X, 3))
                        Liste(Say, 14) = Liste(Say, Y)
                        Exit For
                    End If
                Next
            Else
                For Y = 2 To 14
                    If Month(Veri(X, 2)) = Y - 1 Then
                        Liste(Dizi.Item(Veri(X, 1)), Y) = Liste(Dizi.Item(Veri(X, 1)), Y) + Veri(X, 3)
                        Liste(Dizi.Item(Veri(X, 1)), 14) = Liste(Dizi.Item(Veri(X, 1)), 14) + Veri(X, 3)
                        Exit For
                    End If
                Next
            End If
        End If
    Next

    If Say > 0 Then
        With S2
            With .Range("B3:N3")
                .Value = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", "Eylül", "Ekim", "Kasım", "Aralık", "Yıllık Toplam")
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
                .Borders.LineStyle = 1
                .Interior.ColorIndex = 37
            End With
            With .Range("A4").Resize(Say, 14)
                .Value = Liste
                .NumberFormat = "#,##0.00"
                .Borders.LineStyle = 1
            End With
            
            .Range("N4").Resize(Say, 14).Font.Bold = True
            
            With .Range("A4")
                .Offset(Say).Value = "Genel Toplam"
                .Offset(Say).Resize(1, 14).Font.Bold = True
                .Offset(Say).Resize(1, 14).Interior.ColorIndex = 44
                .Offset(Say).Resize(1, 14).Borders.LineStyle = 1
            End With
            
            With .Range("B4").Offset(Say).Resize(1, 13)
                .Formula = "=SUM(B4:B" & Say + 3 & ")"
                .Value = .Value
            End With

            .Columns.AutoFit
            .Select
        End With
        
        MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
               "İşlem süresi ; " & Format((Timer - Zaman), "0.00")
    Else
        MsgBox Yil & " yılına ait veri bulunamadı!", vbExclamation
    End If

    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing

    Application.ScreenUpdating = True
End Sub

 

[Mdemir63]

Korhan hocam elinize sağlık. teşekkür ederim.

Saygılar

 

[assenucler]

Sayın Ziynettin,
Sayın Korhan Ayhan,

Günaydınlar. Yardımlarınız için ayrı, ayrı teşekkürlere.

Sevgiyle ve sağlıcakla hoşça kalın.