• DİKKAT

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

çok değişkenli veri, bir tablo içinde satır ve sütunda aranıp her değişkene ait değer

Merhaba.

Elbette MAKRO ile de çözüm bulunabilir ancak formül ile çözüm önerisinde bulunayım.
Mavi renklendirdiğim hücre adresini ( kriter AY.YIL'ın yazılı olduğu hücre adresi ) değiştirerek diğer aylar için de sonuç alabilirsiniz.
.
=KAYDIR($A$1;KAÇINCI(SAĞDAN($V$20;4)&" Yılı*";$A:$A;0)+SÜTUN(A1);KAÇINCI(SOLDAN($V$20;BUL(".";$V$20)-1);$B$1:$M$1;0))
 
Ömer bey öncelikle ilginiz için teşekkür ederim, ancak sonuca makro ile gitmemiz gerekli ana dosyada bu değerlerle işlem yapan başka makrolar da var.Aslında bu 4 ay örnekti alt alta kolon indisleri değişen örnekteki gibi aynı satırda sıralı olmayan onlarca ay olabiliyor makro ile çözüm öncelikli tercihim olacaktır ama makro ile sonuca gitmek zor olursa en son formülde olabilir.
 
İlgili verisi çekilecek dönemlerin yazılı olduğu hücrenin konumuna göre formül oluşturmuştum.
Verdiğim formülün istenilen sonuçları vermesiyle ilgili sorun yok değil mi?

Anladığım kadarıyla, gerçek belgenizle, eklediğiniz örnek belge aynı değil.

Bence desteği, gerçek belgenin, özel bilgi içermeyen bir kopyası şeklinde hazırlanacak örnek belge üzerin istemelisiniz.
Varsa kullanılan makrolar/formüller/userformlar örnek belge içerisinde olmalı ki,
bunların birbirleriyle etkileşimleri de gözönünde bulundurularak makro/formül oluşturulabilsin.
.
 
Ömer bey asıl dosyada çok fazla kod ve userform var, anlatım sadeliği olması bakımından sadece yapmakta zorlandığım bölümü göndermek, sizler için de daha anlaşılır olur diye ana dosya karmaşası yaşansın istemedim o yüzden gerçeğe en yakın örnek dosya oluşturdum.
Özetle istenen durum;
örnek dosya" 3" sayfasında makro ile getirdiğim verisi çekilecek dönemler(aylar) var, yapılmasını istediğim sayfa ismi "3" olan dönemlerin olduğu satıra "ENDEKS" sayfasından ilgili dönemlere ait endeksleri getirmesi.
2 nolu mesajda verdiğiniz formül istenilen sonucu veriyor, yalnız dönemler makro ile getirildiği için hangi satırda ve hangi sütunda biteceği belli değil yani dönemler değişken.

Korhan Ayhan ve ziynettin beyin başka konularla ilgili yazdığı kodlar üzerinden birşeyler yapmaya çalıştım ama sonuç olumsuz örnek dosyada bu makro da mevcut.
 
Sorunuzdan anladığım kadarıyla,

Kod:
Sub bul()
Z = TimeValue(Now)
Set s1 = Sheets("ENDEKS")
Set d = CreateObject("scripting.dictionary")

a = s1.[A1:M36]
    For x = 1 To UBound(a) Step 9
        For j = 2 To UBound(a, 2)
            krt = a(x, j) & "." & Left(a(x, 1), 4)
            a(x, j) = krt
            d(krt) = d(krt) & a(x, j)
            For i = 2 To 8
                d(krt) = d(krt) & "|" & a(i + x, j)
            Next i
        Next j
    Next x

a = s1.[V1:Y36].Value2
ReDim b(1 To UBound(a), 1 To 7)
    For i = 1 To UBound(a)
        say = say + 1
        For j = 1 To UBound(a, 2)
            If a(i, j) <> "" Then
                deg = a(i, j)
                ayir = Split(d(deg), "|")
                For x = 1 To UBound(ayir)
                    b(say + 1, x) = ayir(x)
                Next x
            End If
        Next j
    Next i
s1.[O1].Resize(say, 7) = b
MsgBox CDate(TimeValue(Now) - Z), vbInformation
End Sub
 
Ziynettin bey; Çok teşekkür ederim , her zaman ki gibi yine harika bir iş çıkarmışsınız , istenilen sonuca 0 sn yede ulaşmaktadır verdiğiniz kod , tekrar tekrar teşekkür ederim. Bir ufak ilave daha yapılmasını istesem benim 1 haftadır çözemediğim konuyu anında çözdünüz, genel kullanılan bilindik kod yazım düzeninde istediğim değişikleri iyi kötü yapıyorum ama sizin yazılımınız bana biraz zor geliyor o yüzden isteyeceğim ufak müdahale nereye ne yazacağımı bilemediğimdendir.
"" tablo içerisinde o aya ait değer yoksa bir önceki ayı alabilirmiyiz.( örneğin kasım.2018 ve aralık.2018) şu an boş
 
Tabloya göre K3, L3, M3 hücresi boş olduğu için J3'deki (390,84) veri mi yazdırılacak.
 
ekim.2018 boş ise bir önceki ay olan eylül.2018 e ait olan veriler yazılacak örneğin ;
390,84 381,31 806,73 1111,53 345,34 439,78 380,84 yani o ay boş ise bir önceki aya ait değerler zaten veriler her ay açıklanıyor 2-3 ay önceye gitmeye gerek yok sadece 1 ay geriye gitmek yeterli
 
sonradan okuyunca ben bile yazdığımın karmaşık olduğunu gördüm ekim.2018 2. satırdan 8.satıra kadar boş dolayısı ile ekim.2018 yerine eylül.2018 deki değerler yazılacak.
 
Kasım, Aralık aylarına da yazılacak mı? yoksa Ekim ayına yazdırmak yeterli mi?
 
Ekim.2018 ayına yazmak yeterli aranan ay Ekim.2018 olduğunda ekim endeksleri olmadığı için bir önceki ayı almalı kurgu bu.
 
Bu kodu bir kez çalıştırmalısınız.
ilk çalışmada ekim ayına yazdırılıyor. İkinci çalıştırmanızda aynı veriler kasım ayına yazdırılır. Siz sonuçları gözlemleyiniz.

Kod:
Sub test()
Set s1 = Sheets("ENDEKS")
a = s1.Range("A1:M" & s1.Cells(Rows.Count, 1).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 12)
    For i = 1 To UBound(a)
        say = say + 1
        For j = 2 To UBound(a, 2)
            b(say, j - 1) = a(i, j)
            If a(i, j) <> "" Then s = s + 1
        Next j
        If s < 12 Then b(say, s + 1) = a(i, s + 1)
        s = 0
    Next i
s1.[B1].Resize(say, 12) = b
MsgBox "İşlem tamam.", vbInformation
End Sub
 
Ziynettin Bey, son istediğim durumu doğru anlatamadım, haklı olarak farklı bir sonuç çıktı istediğim 7 nolu mesajda verdiğiniz ilk yazılıma küçük bir ilave idi belki ama güzel ifade edemedim isteğimi resim görüntüsü olarak yüklüyorum rahat anlaşılsın diye aslında uğraşmak istemeseniz de bir yerde hak ettim yani:))))))SONUÇ.png
 
emeğiniz çok geçti herşey için teşekkür ederim. Dilerim ve isterim ki Rabbim her daim yar ve yardımcınız olsun. Daha fazla sizi yormak istemem bu hali ile ilk verdiğiniz kod zaten muhteşem yeterli bence.
 
Bu şekilde deneyin.

Kod:
Sub test_1()
Z = TimeValue(Now)
Set s1 = Sheets("ENDEKS")
Set d = CreateObject("scripting.dictionary")
b = s1.Range("A1:M" & s1.Cells(Rows.Count, 1).End(3).Row).Value
ReDim a(1 To UBound(b), 1 To 13)
    For i = 1 To UBound(b)
        say = say + 1
        a(say, 1) = b(i, 1)
        For j = 2 To UBound(a, 2)
            a(say, j) = b(i, j)
            If b(i, j) <> "" Then s = s + 1
        Next j
        If s < 12 Then a(say, s + 2) = b(i, s + 1)
        s = 0
    Next i
    b = a
    For x = 1 To UBound(b) Step 9
        For j = 2 To UBound(b, 2)
            krt = b(x, j) & "." & Left(b(x, 1), 4)
            b(x, j) = krt
            d(krt) = d(krt) & b(x, j)
            For i = 2 To 8
                d(krt) = d(krt) & "|" & b(i + x, j)
            Next i
        Next j
    Next x

a = s1.[V1:Y36].Value2
say = 0
ReDim c(1 To UBound(a), 1 To 7)
    For i = 1 To UBound(a)
        say = say + 1
        For j = 1 To UBound(a, 2)
            If a(i, j) <> "" Then
                deg = a(i, j)
                ayir = Split(d(deg), "|")
                For x = 1 To UBound(ayir)
                    c(say + 1, x) = ayir(x)
                Next x
            End If
        Next j
    Next i
s1.[O1].Resize(say, 7) = c
MsgBox CDate(TimeValue(Now) - Z), vbInformation
End Sub
 
Ziynettin bey çok teşekkür ederim tam istediğim gibi hem hızlı hemde doğru sonuç aldım.
 
Geri
Üst