Aylık TÜFE oranlarını getirme

[mars2]

İyi Günler;

Excelin 1. sayfasında TÜFE oranlar bulunmaktadır.
2. Sayfasının B12 hücresinde başlangıç tarihi
B13 hücresinde ise Bitiş tarihi bulunmmaktadır.

A14 hücresinin altına bu yıl/ayı
B14 hücresine ise oranları alt alta getirmek istemekteyim. aradaki ayların fiyat artış oranları bulup buna göre artış yapmak için.

 

[ÖmerFaruk]

A15 hücresine
=EĞER(SERİTARİH(SERİAY(Sayfa4!$B$12;-1)+1;SATIR(A1)-1)<=SERİAY(Sayfa4!$B$13;-1)+1;SERİTARİH(SERİAY(Sayfa4!$B$12;-1)+1;SATIR(A1)-1);"")

B15 hücresine
=EĞERHATA(KAYDIR(TÜFEENDEKS!$A$4;YIL($A15)-TÜFEENDEKS!$A$5+1;AY($A15);1;1);"")

Aşağı doğru sürükleyerek çoğaltabilirsiniz.

 

[mars2]

Sayın ÖmerFaruk bey;

Formülünüz için teşekkürler, bunu makro ile daha kolay yapmak mümkün değil mi?

Ayrıca, B sutuna gelen değerleri D sutununda yıllar itibarıyla toplamı almak istiyorum.
Örneğin D15 hücresine 2021 yılını yazdığımda bu yılın toplamını alacak förmüle yardıömcı olursanız sevinirim.
çoketopla formüşü ile yapmaya çalıştım baiaramadım.

 

[assenucler]

Sayın mars2,

Paylaşımınız ve Sn. ÖmerFaruk'un katkısı için teşekkürler.

Kendim için düzenlediğim dosyayı ekte yolluyorum. İnşallah işinize yarar.

 

[mars2]

sayın assenucler;

Formulünüz için teşekkürler.

Ancak, oranların taoplamı değil, yıl yıl olarak toplamını almak istiyorum.

Örneğin: D15 = 2020 yılı yazıldığında o yıla ait toplamı
D16 = 2021 yılı yazıldığında o yıla ait toplamı
17 = 2022 yılı yazıldığında o yıla ait toplamı


Örneğinizde 2021 yılına Nisan _ Aralık toplamı 28,16
2022 yılına Ocak _ Mayıs toplamı 31,60 olarak sonucu vermesini istemekteyim.

 

[assenucler]

İstediklerinizi resimde görüleceği gibi kolaylıkla alabilirsiniz.

 

[mars2]

sayın assenucler;

Yardımlarınız için teşekkürler, konuyu tam anlatamadığım zannediyorum.
Siz sadece 1 yıllık dönemi getireyerek sonuca ulaşamaya çalışıyorsunuz. Ancak, Başlangıç tarihi ile günceleme tarihleri arasındaki verileri tek seferde yıllar itibarıyla oranları getirip yılların toplamını almak istiyorum.

Açıklama: B12 hücresine başlangıç tarihini, B13 hücresine bitiş tarihini yazdıktan sonra A15 ..., B15. .... hücrelerine veriler gelmekte, 15, D16 vd yıllar yazılacaktır. Örneği ele alırsak D15 hücresine 2021 yazdığında E16 hücresine o yılın toplamı olan 28,16, D16 hücresine 2022 yazdığımda ise E16 hücresine, o yılın toplamı olan 31,60 yazdırmak istiyorum.

Başlangıç ve bitişi yılları ve ayları sabit olmayıp her zaman değişkendir.

 

[assenucler]

Sayın mars2;


1,5 yıldır görme bozukluğu sorunum var ve tedavi altındayım. Konuya yeterince odaklanamıyor olabilirim. Bunu bir sitem olarak yazmıyorum.
İlgilenen dostlar yanıt verebilirse; ben de sizin adınıza sevinirim.

Sizlere de sağlıklı günler, başarılar ve bol kazançlar dilerim.

Saygılar,
Selim

 

[ÖmerFaruk]

Tüm anlattıklarınızı, bir tablo haline getirip tabloyu manuel olarak doldurur ve paylaşırsanız daha hızlı çözüm alabileceksiniz.

 

[mars2]

Sayın ÖmerFaruk;

Tablo ektedir.

 

[ÖmerFaruk]

D15-D16-D17 hücrelerine 2020-2021-2022 yıllarını manuel olarak mı yazıyorsunuz yoksa B12-B13 deki tarihlerle bir ilişkisi var mı?

 

[mars2]

D15-D16-D17 hücreleri B12-B13 hücreleri ile ilişikli olup D15-D16 devamındaki hücrelerdeki yıllar B12-B13 tarihleri arası olacaktır.

 

[ÖmerFaruk]

Verdiğiniz örnekte ilk tarik 2021 yılı, Son tarih 2022 yılı
D15=2021
D16=2022
olması lazım değil mi? Siz 2020 den başlatmışsınız.

 

[mars2]

evet, B12 hücresinde 2020 yılı olması halinde olacak yoksa ötnek 2021 - 2022 yılları
örneğin

Başlangıç Tarihi	27.04.2020
Güncelleme Tarihi	05.2022

olması halinde, yoksa D15 hücresi 2020 yılı olmayacak

 

[ÖmerFaruk]

Kodlar aşağıda, dosyanız ekte.
Kodlar B12:B13 hücrelerinden herhangi birinde değişiklik yaptığınızda çalışacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Range("B12:B13")) Is Nothing Then Exit Sub
   Dim Sh As Worksheet, ilk As Integer, son As Integer, Date1 As Date, Date2 As Date, Dict As Object, ChkDate As Date
   Application.EnableEvents = False
   Range("A15:B" & Rows.Count).ClearContents
   Range("D15:E" & Rows.Count).ClearContents
   If Not IsDate(Range("B12")) Or Not IsDate(Range("B13")) Then GoTo Bitir
   If Range("B12") > Range("B13") Then GoTo Bitir
   Set Sh = Worksheets("TÜFEENDEKS")
   son = Sh.Range("A" & Rows.Count).End(3).Row
   ilk = Sh.Range("A" & son).End(3).Row
   If ilk < 5 Then Set Sh = Nothing: ilk = Empty: son = Empty: GoTo Bitir
   Date1 = DateSerial(Year([B12]), Month([B12]), 1)
   Date2 = DateSerial(Year([B13]), Month([B13]), 1)
   Arr = Sh.Range("A" & ilk, "M" & son).Value
   ReDim Liste(1 To DateDiff("m", Date1, Date2) + 1, 1 To 2)
   Set Dict = CreateObject("Scripting.Dictionary")
   For i = LBound(Arr) To UBound(Arr)
      For k = LBound(Arr, 2) + 1 To UBound(Arr, 2)
         ChkDate = DateSerial(Arr(i, 1), k - 1, 1)
         If ChkDate > Date2 Then GoTo Devam
         If ChkDate >= Date1 Then
            Say = Say + 1
            Liste(Say, 1) = DateSerial(Year(ChkDate), Month(ChkDate), 1)
            Liste(Say, 2) = Arr(i, k)
            If Not Dict.Exists(Arr(i, 1)) Then
               Dict.Add Arr(i, 1), Arr(i, k)
            Else
               Dict(Arr(i, 1)) = Dict(Arr(i, 1)) + Arr(i, k)
            End If
         End If
      Next k
   Next i
Devam:

   If Say < 1 Or Dict.Count = 0 Then GoTo Bitir
   Range("A15").Resize(Say, 2) = Liste
   For i = 0 To Dict.Count - 1
      Range("D15").Offset(i, 0) = Dict.Keys()(i)
      Range("D15").Offset(i, 1) = Dict.Items()(i)
   Next i
Bitir:
   Application.EnableEvents = True
   Set Dict = Nothing: Set Sh = Nothing: If Not IsEmpty(Arr) Then Erase Arr: Erase Liste
   i = Empty: k = Empty: Say = Empty: ChkDate = Empty: Date1 = Empty: Date2 = Empty
   ilk = Empty: son = Empty
End Sub

 

[mars2]

Sayın rÖmerFaruk;

İlginiz ve emeğiniz teşekkürler.