Basit bir site aidat takibi gelir-gider için makro yardım!

[Endless033]

Aşağıdaki makroyu deneyiniz:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).ClearContents
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                Sheets(i).[C7:F19].Copy s1.Cells(yeniB, "B")
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                Sheets(i).[B25:B30].Copy s1.Cells(yeniH, "H")
                Sheets(i).[E25:F30].Copy s1.Cells(yeniH, "I")
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
            End If
        End If
    Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

denedim karma karışık bir şey oldu yada ben derdimi anlatamadım galiba ben biraz uğraşayım yapamazsam size dönüş yaparım tekrardan.
tşk ediyorum gerçekten bana zaman ayırdığınız için.

 

[Endless033]

demek istediğim mesala 7 satılar 19 satır arasına bi 10 tane daha satır eklersem ve 25 satırla 30 satır arasına bir 10 tane satır eklersem sonradan formül ona göre düzenleme şanşımız olur mu ihtiyaca göre satır ekleyeceğim yani ama bu 10 tane satırıda geçmez

 

[YUSUF44]

Verdiğim makro, #8 nolu mesajınızdaki dosyada, sayfalara satır eklendiğinde de en baştan beri istediğiniz rapor oluşturma işlemini düzgün bir şekilde yapmaktadır. Bundan farklı bir şey mi istiyorsunuz?

 

[Endless033]

mesala en sonki formülü makroyu uyguladım demek istediğim ayın 15 deki sayfanın gelir kısmı ayın 30'da harcamalar kısmındaki satırlar ayın 1'deki taploya göre değişiklik göstermiş oldu formüldede sıkıntı yaşamış oldum..bir kriter koysak ne kadar satır eklersem ekleyeyim hem harcamalar kısmana hemde üst kısma o aralıkta verileri çeksin mümkünse tabiki

 

[Endless033]

mesala en sonki formülü makroyu uyguladım demek istediğim ayın 15 deki sayfanın gelir kısmı ayın 30'da harcamalar kısmındaki satırlar ayın 1'deki taploya göre değişiklik göstermiş oldu formüldede sıkıntı yaşamış oldum..bir kriter koysak ne kadar satır eklersem ekleyeyim hem harcamalar kısmana hemde üst kısma o aralıkta verileri çeksin mümkünse tabiki

 

[YUSUF44]

Paylaştığınız son dosyada verdiğim son makro bulunmuyor. Kendim ekleyip kullandığımda mizan sayfasında raporun düzgün bir şekilde oluştuğunu gördüm. Ayın 15'indeki 18 satır gelir de ayın 30'undaki 10 satır gider de raporda düzgünce görüntüleniyor.

 

[Endless033]

Paylaştığınız son dosyada verdiğim son makro bulunmuyor. Kendim ekleyip kullandığımda mizan sayfasında raporun düzgün bir şekilde oluştuğunu gördüm. Ayın 15'indeki 18 satır gelir de ayın 30'undaki 10 satır gider de raporda düzgünce görüntüleniyor.

ben eklediğimde böyle veri getiriyor siz ekli halini bana göndersenize

 

[YUSUF44]

Düzgün eklememişsiniz ya da hiç eklemememişsiniz. Son verdiğim kodları kopyalayın. Dosyanıza geçin. Eski makroları silin. Verdiğim kodları yapıştırın. Basit bir kopyala yapıştır işlemi için dosya yüklemek gereksiz olur.

 

[Endless033]

tamam yusuf bey haklısınız.

 

[Endless033]

Düzgün eklememişsiniz ya da hiç eklemememişsiniz. Son verdiğim kodları kopyalayın. Dosyanıza geçin. Eski makroları silin. Verdiğim kodları yapıştırın. Basit bir kopyala yapıştır işlemi için dosya yüklemek gereksiz olur.

aynen yusuf bey makroyu silince düzeldi yalnız gider kısmının en altıa gereksiz hücre kenarlıkları ekliyor o sizdede oluyor mu..tşk ettim

 

[YUSUF44]

Son sayfadaki boş satırları da kopyaladıktan sonra biçimlendirme işlemini rapor sayfasındaki dolu hücrelere göre yapıyor. Son sayfanın boş hücrelerindeki biçimler altta kalıyor. Aşağıdaki kodları deneyin:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).Clear
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                songelir = Sheets(i).Cells.Find("GÜNÜN TAHSİLAT TOPLAMI", , , , xlByRows, xlPrevious).Row - 1
                Sheets(i).Range("C7:F" & songelir).Copy: s1.Cells(yeniB, "B").PasteSpecial Paste:=xlValues
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
                With s1.Range("A" & yeniB & ":E" & sonB)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                ilkgider = Sheets(i).Cells.Find("HARCAMALAR", , , , xlByRows, xlPrevious).Row + 1
                songider = Sheets(i).Cells.Find("TOPLAM HARCAMA", , , , xlByRows, xlPrevious).Row - 1
                Sheets(i).Range("B" & ilkgider & ":B" & songider).Copy: s1.Cells(yeniH, "H").PasteSpecial Paste:=xlValues
                Sheets(i).Range("E" & ilkgider & ":F" & songider).Copy: s1.Cells(yeniH, "I").PasteSpecial Paste:=xlValues
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
                With s1.Range("G" & yeniH & ":J" & sonH)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
        End If
    Next
    ensonB = s1.Cells(Rows.Count, "B").End(3).Row
    s1.Range("A6:A" & ensonB).NumberFormat = "dd/mm/yyyy"
    s1.Range("A6:A" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("D6:D" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("E6:E" & ensonB).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("A6:E" & ensonB).VerticalAlignment = xlCenter
    s1.Range("A6:E" & ensonB).Font.Bold = False
    
    ensonG = s1.Cells(Rows.Count, "G").End(3).Row
    s1.Range("G6:G" & ensonG).NumberFormat = "dd/mm/yyyy"
    s1.Range("G6:G" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("I6:I" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("J6:J" & ensonG).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("G6:J" & ensonG).VerticalAlignment = xlCenter
    s1.Range("G6:J" & ensonG).Font.Bold = False
    s1.Range("J6:J" & ensonG).HorizontalAlignment = xlRight
    
    s1.Columns("A:J").EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

 

[Endless033]

Son sayfadaki boş satırları da kopyaladıktan sonra biçimlendirme işlemini rapor sayfasındaki dolu hücrelere göre yapıyor. Son sayfanın boş hücrelerindeki biçimler altta kalıyor. Aşağıdaki kodları deneyin:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).Clear
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                songelir = Sheets(i).Cells.Find("GÜNÜN TAHSİLAT TOPLAMI", , , , xlByRows, xlPrevious).Row - 1
                Sheets(i).Range("C7:F" & songelir).Copy: s1.Cells(yeniB, "B").PasteSpecial Paste:=xlValues
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
                With s1.Range("A" & yeniB & ":E" & sonB)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                ilkgider = Sheets(i).Cells.Find("HARCAMALAR", , , , xlByRows, xlPrevious).Row + 1
                songider = Sheets(i).Cells.Find("TOPLAM HARCAMA", , , , xlByRows, xlPrevious).Row - 1
                Sheets(i).Range("B" & ilkgider & ":B" & songider).Copy: s1.Cells(yeniH, "H").PasteSpecial Paste:=xlValues
                Sheets(i).Range("E" & ilkgider & ":F" & songider).Copy: s1.Cells(yeniH, "I").PasteSpecial Paste:=xlValues
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
                With s1.Range("G" & yeniH & ":J" & sonH)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
        End If
    Next
    ensonB = s1.Cells(Rows.Count, "B").End(3).Row
    s1.Range("A6:A" & ensonB).NumberFormat = "dd/mm/yyyy"
    s1.Range("A6:A" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("D6:D" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("E6:E" & ensonB).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("A6:E" & ensonB).VerticalAlignment = xlCenter
    s1.Range("A6:E" & ensonB).Font.Bold = False
   
    ensonG = s1.Cells(Rows.Count, "G").End(3).Row
    s1.Range("G6:G" & ensonG).NumberFormat = "dd/mm/yyyy"
    s1.Range("G6:G" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("I6:I" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("J6:J" & ensonG).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("G6:J" & ensonG).VerticalAlignment = xlCenter
    s1.Range("G6:J" & ensonG).Font.Bold = False
    s1.Range("J6:J" & ensonG).HorizontalAlignment = xlRight
   
    s1.Columns("A:J").EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

Tşkler denedim yusuf bey ellerinize sağlık.

 

[Endless033]

yusuf bey daha önce yapmış olduğumuzu az daha geliştirmek istedim önceki yaptığımızı tablodan vazgeçemeyeceğiz için yanına başka sayfalar ekledim onlar makro yazmak istiyorum ama bu konuda fazla iyi değilim yardımcı olursanız sevinirim kısacası ben anlatayım

-üye kayıt sayfası : kaç üye varsa sabit değişiklik oldukça güncelleyeceğim kısım
-veri girişi sayfası : tüm bilgilerin tek yere kayıt altına alınması ve tüm raporlama ve diğer sayfalara bu sayfadan bilgileri istediğimiz şekilde rapolanması ve topla analizlerini bu sayfadan çekeceğiz
bu sayfada mesala gider türlerine göre nevi1 ,nevi2,nevi3,nevi4,nevi5 şeklinde hücrelere gider türüne göre biz girişini yapacağız o kısma tanımlar sayfasındaki giderleri açılır kutu yapmak isiyorum ve aynı çekilde mizan genel taploya ilgili kısımlara toplamlarını toplamasını sağlamamız gerekli
rapolar kısmına aynı şeklide üste yer alan tarih aralıklarına göre veri giriş sayfasından verileri çekmesini ve her defasında raporla dediğimizde önceki raporlanan veriyi silip tekrardan yeni liste oluşturacak şekilde bir makro yazmak gerekiyor ne yapmak istediğimi bilen fakar makroyu tam anlamıyla bilmediğim için işi tamamlayamıyorum yardımcı olursanız ve olacak kişilerden şimdiden tşkler ederim..

-raporla kısmında istediğim yeri raporlayınca üye hareketleri ve kalan bakiyeyi gösterecek sonuçta hareketleri ordan görürüm kalanı diye düşünüyorum
-diğer konuda işletme defteri ay sonunda işletme defterine raporla dediğimizde gelirleri gelirler kısmına giderleri giderler kısmına nasıl uyarlarız onda hiç bir fikrim yok sadece taployu ekledim


-en önemlisi sizin daha önceki yaptıgınız taplodan vazgeçmeyeceğim için sayfa rengi kırmızı olmayan kısım 1-31 numaralı sayfalara veri sayfasındaki ilgili alakalı hücreleri tarihe göre ora atamasını istiyorum bu bu taplodan vazgeçemeyeceğim için yapmamız gerekiyor yoksa dierleri zaten aynı bilgiyi verecek biliyorum ama onada uyarlasak güzel olacak biraz fazla yazdım hakkınızı helal edin..

 

[YUSUF44]

Bu artık konu başlığındaki gibi "Basit" bir site aidat takip dosyası değil

Öncelikle daha önce de belirtmiştim yanlış hatırlamıyorsam, şimdi de belirteyim: Her gün için ayrı sayfa olması hiç mantıklı ve kullanışlı bir uygulama değil. Veri girişi sayfasında yaptığınız tüm işlemleri istediğiniz şekilde, günlük, aylık, haftalık olarak veya başka şekilde raporlayabilirsiniz zaten. Her gün için ayrı sayfada görünmesinin ne önemi olduğunu anlayamadım.

Diğer hususlarla ilgili olarak tam olarak hangi sayfa için nasıl bir düzenleme istediğinizi belirtirseniz uğraşmaya çalışırım ama söz veremem maalesef.