• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru Vadelerine göre aylık toplamları alma

  • Konbuyu başlatan Konbuyu başlatan relaxim
  • Başlangıç tarihi Başlangıç tarihi
relaxim

relaxim

Altın Üye
Katılım
30 Ağustos 2009
Mesajlar
589
Excel Vers. ve Dili
LTSC Pro Plus 2024 Türkçe
Örnekte açıklamaya çalıştım. Genel sayfasından Firmalar sayfasına firmaların alacak bakiye durumlarını alıyorum. Sizden istediğim firmaların vadesi geçenleri bir sütuna , vadesi bu ay dolanları bir sütuna ve vadesi gelecek ay dolacakları bir sütuna miktarlarını toplatabilmek. Yardımlarınız için teşekkür ederim.
 

Ekli dosyalar

Merhaba.

Örnek belgenizde olması gereken sonuçlara ilişkin birkaç satırlık veri yazıp örnek belgenizi yenilerseniz daha hızlı sonuca ulaşırsınız.
Olması gereken sonuçları haricen hesaplayıp, olması gereken hücrelere yazın ve bu sonuçları nasıl bulduğunuzu,
metin kutularında veya uygun hücrelerde kısa ve net olarak açıklayın.
Sorunuz cevapsız kalmayacak, bir forum üyesi mutlaka çözüm önerisinde bulunacaktır.
.
 
Ömer Bey ilgi ve uyarınız için teşekkürler. Örneği biraz daha açıklama yaparak güncelledim. Programın devamı ve başka sayfalar var. Şu anda firmaları tek tek ekstre alabiliyorum. Amacım özet olarak Firmalar sayfasında vadesi geçenler , bu ay vadesi dolacaklar ve gelecek ay vadesi dolacaklar olarak görmek istiyorum. Bunun için farklı önerisi olan varsa memnun olurum. Saygılarımla.
 
Örnek belgedeki sayısal sonuçları nasıl bulduğunuzu açıklamamışsınız.
Örneğin BOZANKAYA firması için;
-- verdiğiniz üç sonucun toplamı: 64.134,19. Bu değer diğer sayfada nerede?
-- 25.750,00 kısmı anlaşılıyor gibi ama 18.923,40 ve 19.460,79 değerlerini nasıl buluyorsunuz?
.
 
Ömer BARAN' Alıntı:
Örnek belgedeki sayısal sonuçları nasıl bulduğunuzu açıklamamışsınız.
Örneğin BOZANKAYA firması için;
-- verdiğiniz üç sonucun toplamı: 64.134,19. Bu değer diğer sayfada nerede?
-- 25.750,00 kısmı anlaşılıyor gibi ama 18.923,40 ve 19.460,79 değerlerini nasıl buluyorsunuz?
.
Genişletmek için tıkla ...
Ömer Bey merhaba,

Vade sütunundaki ilgili ayın en büyük tarihli satırında M sütunundaki bulunan Bakiye den bir önceki ayın en büyük tarihli M sütunundaki Bakiye miktarını çıkartarak buluyorum. Örnek Çalışma sayfasında 44,673,40 tan 25.750,00 yi çıkarttığımızda 18.923,40 değeri bulunuyor. 64.134,19 dan 44.673.40 çıkarttığımızda 19.460,79 değeri bulunuyor.
 
Merhaba,

Genel sayfasına göre; Firmalar sayfası J4:L25 alanında olmasını istediğiniz değerlerle dosyanızı güncelleyin, sonuca göre çözüm bulmaya bakalım..
 
Ömer BARAN' Alıntı:
Örnek belgedeki sayısal sonuçları nasıl bulduğunuzu açıklamamışsınız.
Örneğin BOZANKAYA firması için;
-- verdiğiniz üç sonucun toplamı: 64.134,19. Bu değer diğer sayfada nerede?
-- 25.750,00 kısmı anlaşılıyor gibi ama 18.923,40 ve 19.460,79 değerlerini nasıl buluyorsunuz?
.
Genişletmek için tıkla ...
Ömer Bey merhaba,

64.134,40 değeri kasım ayının Bozankaya için en büyük değeri olan M109 da.
 
Ziynettin' Alıntı:
Merhaba,

Genel sayfasına göre; Firmalar sayfası J4:L25 alanında olmasını istediğiniz değerlerle dosyanızı güncelleyin, sonuca göre çözüm bulmaya bakalım..
Genişletmek için tıkla ...
Ziynettin Bey merhaba, ilginiz için teşekkür ederim.
Örneği 15. satıra kadar olmasını istediğim şekilde doldurarak güncelledim.
Olayın özeti şu;
1.Genel sayfasında istediğim firmayı süzüyorum.
2.Vadesine göre artan sırada sıralattırıyorum.
3.10 ayda olduğumuz için 9. ayın en son vadeli tarihinde M sütunundaki veri geçen ay (örneğimizde 26.09.2018)
4.10. ayın en son vadeli tarihinde M sütunundaki veri bu ay (örneğimizde 28.10.2018)
5.11. ayın en son vadeli tarihinde M sütunundaki veri gelecek ay (örneğimizde 24.11.2018) olarak firmalar sayfasında ilgili firmanın karşısına J,K ve L sütunlarında yazsın istiyorum.
Toplam bakiyeyi I sütununda görüyorum. Ancak vadesi geçen veya bu ay , gelecek ay bakiyesi nedir. Bunları yukarıda yaptığım işlemleri gerçek çalışmamda olan EKSTRE sayfasında firma bazında tek tek görüyorum. Hepsini bir arada görebilmek adına firmalar sayfasında ilgili sütunlarda veriler olursa iyi olacak.

Saygılarımla.
 
Firmalar sayfası 14. satır DEV GRUP üzerinden gidelim.
Geçen ay: -1.438,96
Bu ay: -4.210,65
Gelecek ay: 0
Bakiye: -4.211

Ay toplamları bakiye toplamını vermiyor. Bu ay: -2771,69 sonucu değil mi? Kontrol ediniz.


Kod: 
Sub test()
Set s1 = Sheets("GENEL")
Set S2 = Sheets("FİRMALAR")
Set d1 = CreateObject("Scripting.dictionary")
Set d2 = CreateObject("Scripting.dictionary")
Set d3 = CreateObject("Scripting.dictionary")


On Error Resume Next
a = s1.Range("A2:M" & s1.Cells(Rows.Count, 1).End(3).Row).Value

For i = UBound(a) To 1 Step -1
    If Month(a(i, 2)) = 9 Then
    krt = a(i, 1)
        If d1.exists(krt) Then
            If a(i, 2) > a(d1(krt), 2) Then d1(krt) = i
        Else
            d1(krt) = i
        End If
    End If
    
    If Month(a(i, 2)) = 10 Then
    krt = a(i, 1)
        If d2.exists(krt) Then
            If a(i, 2) > a(d2(krt), 2) Then d2(krt) = i
        Else
            d2(krt) = i
        End If
    End If
    
    If Month(a(i, 2)) = 11 Then
    krt = a(i, 1)
        If d3.exists(krt) Then
            If a(i, 2) > a(d3(krt), 2) Then d3(krt) = i
        Else
            d3(krt) = i
        End If
    End If
Next i

b = S2.Range("A4:A" & S2.Cells(Rows.Count, 1).End(3).Row).Value
ReDim c(1 To UBound(b), 1 To 3)

For i = 1 To UBound(b)
krt = b(i, 1)
k1 = CDbl(a(d1(krt), 13))
k2 = CDbl(a(d2(krt), 13))
k3 = CDbl(a(d3(krt), 13))
c(i, 1) = k1
If k2 = 0 Then c(i, 2) = k2 Else c(i, 2) = k2 - k1
If k3 = 0 Then c(i, 3) = k3 Else c(i, 3) = k3 - k2
k1 = 0
k2 = 0
k3 = 0
Next i

S2.[N4].Resize(UBound(b), 3) = c
MsgBox "İşlem tamam.", vbInformation
End Sub
 
Son düzenleme:
relaxim' Alıntı:
Örnekte açıklamaya çalıştım. Genel sayfasından Firmalar sayfasına firmaların alacak bakiye durumlarını alıyorum. Sizden istediğim firmaların vadesi geçenleri bir sütuna , vadesi bu ay dolanları bir sütuna ve vadesi gelecek ay dolacakları bir sütuna miktarlarını toplatabilmek. Yardımlarınız için teşekkür ederim.
Genişletmek için tıkla ...
Formül ile çözüme ihtiyacınız olursa, ekli dosyayı inceleyiniz.
İyi çalışmalar.
 

Ekli dosyalar

Ziynettin' Alıntı:
Firmalar sayfası 14. satır DEV GRUP üzerinden gidelim.
Geçen ay: -1.438,96
Bu ay: -4.210,65
Gelecek ay: 0
Bakiye: -4.211

Ay toplamları bakiye toplamını vermiyor. Bu ay: -2771,69 sonucu değil mi? Kontrol ediniz.


Kod: 
Sub test()
Set s1 = Sheets("GENEL")
Set S2 = Sheets("FİRMALAR")
Set d1 = CreateObject("Scripting.dictionary")
Set d2 = CreateObject("Scripting.dictionary")
Set d3 = CreateObject("Scripting.dictionary")


On Error Resume Next
a = s1.Range("A2:M" & s1.Cells(Rows.Count, 1).End(3).Row).Value

For i = UBound(a) To 1 Step -1
    If Month(a(i, 2)) = 9 Then
    krt = a(i, 1)
        If d1.exists(krt) Then
            If a(i, 2) > a(d1(krt), 2) Then d1(krt) = i
        Else
            d1(krt) = i
        End If
    End If
   
    If Month(a(i, 2)) = 10 Then
    krt = a(i, 1)
        If d2.exists(krt) Then
            If a(i, 2) > a(d2(krt), 2) Then d2(krt) = i
        Else
            d2(krt) = i
        End If
    End If
   
    If Month(a(i, 2)) = 11 Then
    krt = a(i, 1)
        If d3.exists(krt) Then
            If a(i, 2) > a(d3(krt), 2) Then d3(krt) = i
        Else
            d3(krt) = i
        End If
    End If
Next i

b = S2.Range("A4:A" & S2.Cells(Rows.Count, 1).End(3).Row).Value
ReDim c(1 To UBound(b), 1 To 3)

For i = 1 To UBound(b)
krt = b(i, 1)
k1 = CDbl(a(d1(krt), 13))
k2 = CDbl(a(d2(krt), 13))
k3 = CDbl(a(d3(krt), 13))
c(i, 1) = k1
If k2 = 0 Then c(i, 2) = k2 Else c(i, 2) = k2 - k1
If k3 = 0 Then c(i, 3) = k3 Else c(i, 3) = k3 - k2
k1 = 0
k2 = 0
k3 = 0
Next i

S2.[N4].Resize(UBound(b), 3) = c
MsgBox "İşlem tamam.", vbInformation
End Sub
Genişletmek için tıkla ...
Hocam dediğiniz sonuç doğru, ay toplamları sadece o ayın bakiyesini verecek sadece geçen ay önceki bütün ayları alacak.

Kodu nereye yapıştırmam lazım ben çalıştıramadım.

Saygılar...
 
turist' Alıntı:
Formül ile çözüme ihtiyacınız olursa, ekli dosyayı inceleyiniz.
İyi çalışmalar.
Genişletmek için tıkla ...

Turist hocam merhaba,

Sizin çözümünüzü yapmaya çalışmıştım içinden çıkamamıştım. Sizin çözümde tek sorun gelecek ay bu aydan sonraki bütün ayları kapsıyor. Formülle 2000 satırda kasma yapmaz umarım. Sizin formül üzerinde biraz daha çalışacağım. İlgi ve alakanız için teşekkür ederim.

Saygılar...
 
relaxim' Alıntı:
Turist hocam merhaba,

Sizin çözümünüzü yapmaya çalışmıştım içinden çıkamamıştım. Sizin çözümde tek sorun gelecek ay bu aydan sonraki bütün ayları kapsıyor. Formülle 2000 satırda kasma yapmaz umarım. Sizin formül üzerinde biraz daha çalışacağım. İlgi ve alakanız için teşekkür ederim.

Saygılar...
Genişletmek için tıkla ...
Sağolun,
Gelecek ayı "GENEL" sayfasındaki "R" sütununda uygulanan formülle düzenleyebilirsiniz, hatta belki "sonraki aylar" diye ek bilgi de bulabilirsiniz.
Umarım,bundan sonrasını siz düzenleyebilirsiniz.
Yine de herhangi bir ihtiyaç olursa lütfen forumda belirtiniz.
 
relaxim' Alıntı:
Hocam dediğiniz sonuç doğru, ay toplamları sadece o ayın bakiyesini verecek sadece geçen ay önceki bütün ayları alacak.

Kodu nereye yapıştırmam lazım ben çalıştıramadım.

Saygılar...
Genişletmek için tıkla ...

Dosyanız.
 

Ekli dosyalar

Ziynettin' Alıntı:
Dosyanız.
Genişletmek için tıkla ...

Ziynettin Hocam merhaba, İş yerinde gerçek programda denedim. Bazılarında olmadık sonuçlar çıktı. Bazıları da doğru çıktı. İlginiz için teşekkürler. Koddan anlamadığım için müdahale edemiyorum, sanırım formülle yapacağım.

Saygılar...
 
Merhabalar.

Aşağıdaki kod'u dener misiniz?
İşlem öncesinde BARAN isimli boş bir sayfa ekleyin, işlemler orada yapılıp, sonuçları asıl sayfaya yazılıyor.
Ekleyeceğiniz boş sayfanın adını farklı adlandıracaksanız kod'daki ilgili sayfa adını buna göre değiştirin.

İşlem sırasında;
-- önceki aylar için kriter bu ay'dan önceki tüm tarihler değil, sadece bir önceki ay ise
mavi renklendirdiğim kısmı ve sağındaki TEK TIRNAK işaretini silin,
-- sonraki ay için kriter bu aydan sonraki tüm tarihler değil, bu aydan bir sonraki ay ise
kırmızı kısmı ve sağındaki TEK TIRNAK işaretini silin.

İşlem akışı tam olarak 8 numaralı cevapta açıkladığınız şekildedir,
FİRMAya göre filtrele, önce eski tarihi, sonra bu ayı sonra da gelecek ayı filtrele, kalan satırları BARAN isimli
yeni sayfaya yapıştır, yapıştırılan verileri B sütununa göre artan sırala, en altta kalan (en büyük tarihli)
satırda M sütunundaki değeri ilgili hücreye yaz.
Kod: 
Sub SOYLU_BRN()
Set f = Sheets("FİRMALAR")
Set g = Sheets("GENEL")
Set b = Sheets("BARAN")

If g.AutoFilterMode = True Then g.AutoFilterMode = False
fson = f.Cells(Rows.Count, 1).End(3).Row
gson = g.Cells(Rows.Count, 1).End(3).Row
f.Range("J4:L" & fson).ClearContents

eskiilk = WorksheetFunction.Min(g.[B:B]) 'CDate("1/" & Month(Date) - 1 & "/" & Year(Date))
eskison = CDate("1/" & Month(Date) & "/" & Year(Date)) - 1

buayilk = CDate("1/" & Month(Date) & "/" & Year(Date))
buayson = CDate("1/" & Month(Date) + 1 & "/" & Year(Date)) - 1

yeniilk = CDate("1/" & Month(Date) + 1 & "/" & Year(Date))
yenison = WorksheetFunction.Max(g.[B:B]) 'CDate("1/" & Month(Date) + 2 & "/" & Year(Date)) - 1

Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For fsat = 4 To f.Cells(Rows.Count, 1).End(3).Row
    firma = f.Cells(fsat, 1)
    For kr = 1 To 3
        If kr = 1 Then kriter1 = eskiilk: kriter2 = eskison
        If kr = 2 Then kriter1 = buayilk: kriter2 = buayson
        If kr = 3 Then kriter1 = yeniilk: kriter2 = yenison
    g.Range("A1:P" & gson).AutoFilter Field:=1, Criteria1:=firma
    g.Range("A1:P" & gson).AutoFilter Field:=2, Criteria1:=">=" & _
            CLng(kriter1), Operator:=xlAnd, Criteria2:="<=" & CLng(kriter2)
        bakiye = 0
        If g.Cells(Rows.Count, 1).End(3).Row > 1 Then
            b.Cells.Clear
            
            g.Range("A2:M" & gson).SpecialCells(xlCellTypeVisible).Copy
            b.[A1].PasteSpecial Paste:=xlPasteValues
            b.Range("A1:M" & Rows.Count).Sort b.[B1], 1
            bakiye = b.Cells(b.Cells(Rows.Count, 1).End(3).Row, "M")
        End If
            
            If kr = 3 Then
                f.Cells(fsat, kr + 9) = bakiye - f.Cells(fsat, kr + 8)
            Else
                f.Cells(fsat, kr + 9) = bakiye
            End If
    Next
Next
If g.AutoFilterMode = True Then g.AutoFilterMode = False
b.Cells.Clear: f.Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic

MsgBox "İŞLEM TAMAMLANDI.", vbInformation, "..:: Ömer BARAN ::.."
End Sub
 
Ömer BARAN' Alıntı:
Merhabalar.

Aşağıdaki kod'u dener misiniz?
İşlem öncesinde BARAN isimli boş bir sayfa ekleyin, işlemler orada yapılıp, sonuçları asıl sayfaya yazılıyor.
Ekleyeceğiniz boş sayfanın adını farklı adlandıracaksanız kod'daki ilgili sayfa adını buna göre değiştirin.

İşlem sırasında;
-- önceki aylar için kriter bu ay'dan önceki tüm tarihler değil, sadece bir önceki ay ise
mavi renklendirdiğim kısmı ve sağındaki TEK TIRNAK işaretini silin,
-- sonraki ay için kriter bu aydan sonraki tüm tarihler değil, bu aydan bir sonraki ay ise
kırmızı kısmı ve sağındaki TEK TIRNAK işaretini silin.

İşlem akışı tam olarak 8 numaralı cevapta açıkladığınız şekildedir,
FİRMAya göre filtrele, önce eski tarihi, sonra bu ayı sonra da gelecek ayı filtrele, kalan satırları BARAN isimli
yeni sayfaya yapıştır, yapıştırılan verileri B sütununa göre artan sırala, en altta kalan (en büyük tarihli)
satırda M sütunundaki değeri ilgili hücreye yaz.
Kod: 
Sub SOYLU_BRN()
Set f = Sheets("FİRMALAR")
Set g = Sheets("GENEL")
Set b = Sheets("BARAN")

If g.AutoFilterMode = True Then g.AutoFilterMode = False
fson = f.Cells(Rows.Count, 1).End(3).Row
gson = g.Cells(Rows.Count, 1).End(3).Row
f.Range("J4:L" & fson).ClearContents

eskiilk = WorksheetFunction.Min(g.[B:B]) 'CDate("1/" & Month(Date) - 1 & "/" & Year(Date))
eskison = CDate("1/" & Month(Date) & "/" & Year(Date)) - 1

buayilk = CDate("1/" & Month(Date) & "/" & Year(Date))
buayson = CDate("1/" & Month(Date) + 1 & "/" & Year(Date)) - 1

yeniilk = CDate("1/" & Month(Date) + 1 & "/" & Year(Date))
yenison = WorksheetFunction.Max(g.[B:B]) 'CDate("1/" & Month(Date) + 2 & "/" & Year(Date)) - 1

Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For fsat = 4 To f.Cells(Rows.Count, 1).End(3).Row
    firma = f.Cells(fsat, 1)
    For kr = 1 To 3
        If kr = 1 Then kriter1 = eskiilk: kriter2 = eskison
        If kr = 2 Then kriter1 = buayilk: kriter2 = buayson
        If kr = 3 Then kriter1 = yeniilk: kriter2 = yenison
    g.Range("A1:P" & gson).AutoFilter Field:=1, Criteria1:=firma
    g.Range("A1:P" & gson).AutoFilter Field:=2, Criteria1:=">=" & _
            CLng(kriter1), Operator:=xlAnd, Criteria2:="<=" & CLng(kriter2)
        bakiye = 0
        If g.Cells(Rows.Count, 1).End(3).Row > 1 Then
            b.Cells.Clear
         
            g.Range("A2:M" & gson).SpecialCells(xlCellTypeVisible).Copy
            b.[A1].PasteSpecial Paste:=xlPasteValues
            b.Range("A1:M" & Rows.Count).Sort b.[B1], 1
            bakiye = b.Cells(b.Cells(Rows.Count, 1).End(3).Row, "M")
        End If
         
            If kr = 3 Then
                f.Cells(fsat, kr + 9) = bakiye - f.Cells(fsat, kr + 8)
            Else
                f.Cells(fsat, kr + 9) = bakiye
            End If
    Next
Next
If g.AutoFilterMode = True Then g.AutoFilterMode = False
b.Cells.Clear: f.Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic

MsgBox "İŞLEM TAMAMLANDI.", vbInformation, "..:: Ömer BARAN ::.."
End Sub
Genişletmek için tıkla ...

Ömer Bey merhaba, ilgi ve alakanız için teşekkürler. Şöyle bir hata aldım. Ekran resmini ekledim. Bu kodu tam olarak nereye eklemeliyim? Programın aslını özelden gönderebilirim.
 

Ekli dosyalar

  • Adsız.png
    Adsız.png
    105.2 KB · Görüntüleme: 5
Son düzenleme:
Tekrar merhaba.

Aşağıdaki kod'u kullanabilirsiniz. (BARAN adını vererek boş sayfa eklemenize gerek yok)
Kod'u, GENEL sayfası B sütunundaki formül hatalarını gözden geçirdikten sonra uygulayınız.
NOT: Kod, BOZANKAYA adlı firma ile ilgili açıklamalarınız doğrultusunda oluşturulmuştur.
Rich (BB code): 
Sub SOYLU_BRN2()
Set f = Sheets("FİRMALAR"): Set g = Sheets("GENEL")
fson = f.Cells(Rows.Count, 1).End(3).Row: gson = g.Cells(Rows.Count, 1).End(3).Row
f.Range("J4:L" & fson).NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
If f.Cells(Rows.Count, 10).End(3).Row > 3 Then f.Range("J4:L" & Rows.Count).ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    f.[J4].Formula = "=ROUND(SUMPRODUCT((GENEL!$A$2:$A$" & gson & "=$A4)*(GENEL!$B$2:$B$" & _
                            gson & "<EOMONTH(TODAY(),-1)+1)*(GENEL!$L$2:$L$" & gson & ")),2)"
    f.[K4].Formula = "=ROUND(SUMPRODUCT((GENEL!$A$2:$A$" & gson & "=$A4)*((GENEL!$B$2:$B$" & gson & _
        "<=EOMONTH(TODAY(),0))-(GENEL!$B$2:$B$" & gson & "<EOMONTH(TODAY(),-1)+1))*(GENEL!$L$2:$L$" & gson & ")),2)"
    f.[L4].Formula = "=ROUND(SUMPRODUCT((GENEL!$A$2:$A$" & gson & "=$A4)*(GENEL!$B$2:$B$" & gson & _
        ">EOMONTH(TODAY(),0))*(GENEL!$B$2:$B$" & gson & "<=EOMONTH(TODAY(),1))*(GENEL!$L$2:$L$" & gson & ")),2)"
f.Range("J4:L4").AutoFill Destination:=f.Range("J4:L" & fson)
f.Range("J4:L" & fson).Calculate
f.Range("J4:L" & fson).Value = f.Range("J4:L" & fson).Value
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İŞLEM TAMAMLANDI.", vbInformation, "..:: Ömer BARAN ::.."
End Sub
 
Son düzenleme:
Ömer Bey merhaba,

Range sınıfının AutoFill yöntemi başarısız yazdı . Hata veren satır;

f.Range("J4:L4").AutoFill Destination:=Range("J4:L" & fson)

Devam dediğimde aynı hatayı tekrarlıyor. Bir kez hesaplama yaptı sonuçları doğru görünüyor.

Normalde C sütununa göre sıralama var. Bu kodun doğru çalışması için önce B sütununa göre sıralama yapması lazım.
Saygılarımla.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst