Koşullu çoklu veri getirme

[Lokmanx]

Merhaba ,

İlgili linkte yer alan data isimli sayfada yer alan verilerin yanda sorgu sayfasına formatlardaki gibi gelmesini istiyorum.

Veri girişi alanında KOD-IBAN ve HESAP ADI kriterlerine göre datadan tabloya veri gelmesi gerekiyor. Bu 3 alan birbirinden bağımsız olmalı tablolardaki gibi.

KOD C3 hücresinden, Hesap adı C4 hücresine, IBAN ise C5 hücrelerine işleniyor ve altlardaki tablolarda başlıklara göre veri gelmesini gerekiyor.

Konu hakkında yardımcı olmanız mümkün mü acaba?

Kosullu_veri_getirme.xlsx dosyasını indir - download

Kosullu_veri_getirme.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

İyi çalışmalar

 

[Lokmanx]

Merhaba ,

Konu ile ilgili yardımcı olabilecek var mı acaba ?

İyi çalışmalar

 

[Lokmanx]

Yardımcı olmak isteyenler için dosya ekteki gibidir.

İyi çalışmalar

 

[Lokmanx]

Merhaba ,

Konu ile ilgili yardımcı olabilecek var mı acaba ?

İyi çalışmalar

 

[ÖmerFaruk]

Aşağıdaki kodları SorguEkranı sayfasında çalıştırabilirsin.

Sub KosulluVeriGetir()
    Dim Liste1(), Liste2(), Liste3(), Say1 As Integer, Say2 As Integer, Say3 As Integer, i As Long
    Veri = Worksheets("Data").Range("A1").CurrentRegion.Value
    Range("D:XFD").Clear
    For i = 2 To UBound(Veri)
        If Range("C3") = Veri(i, 2) Then
            Say1 = Say1 + 1
            ReDim Preserve Liste1(1 To 7, 1 To Say1)
            Liste1(1, Say1) = "VERİ" & Say1
            Liste1(4, Say1) = Veri(i, 3)
            Liste1(5, Say1) = Veri(i, 6)
            Liste1(6, Say1) = Veri(i, 8)
            Liste1(7, Say1) = Veri(i, 9)
        End If
        If Range("C4") = Veri(i, 3) Then
            Say2 = Say2 + 1
            ReDim Preserve Liste2(1 To 7, 1 To Say2)
            Liste2(1, Say2) = "VERİ" & Say2
            Liste2(4, Say2) = Veri(i, 2)
            Liste2(5, Say2) = Veri(i, 6)
            Liste2(6, Say2) = Veri(i, 8)
            Liste2(7, Say2) = Veri(i, 9)
        End If
        If Range("C5") = Veri(i, 6) Then
            Say3 = Say3 + 1
            ReDim Preserve Liste3(1 To 7, 1 To Say3)
            Liste3(1, Say3) = "VERİ" & Say3
            Liste3(4, Say3) = Veri(i, 2)
            Liste3(5, Say3) = Veri(i, 3)
            Liste3(6, Say3) = Veri(i, 8)
            Liste3(7, Say3) = Veri(i, 9)
        End If
    Next i
        Range("D9").Resize(7, Say1) = Liste1
        Range("D20").Resize(7, Say2) = Liste2
        Range("D30").Resize(7, Say3) = Liste3
        Say = WorksheetFunction.Max(Say1, Say2, Say3) + 3
        For i = Say1 + 1 To Say
            ReDim Preserve Liste1(1 To 7, 1 To i)
            Liste1(1, i) = "VERİ" & i
        Next i
        For i = Say2 + 1 To Say
            ReDim Preserve Liste2(1 To 7, 1 To i)
            Liste2(1, i) = "VERİ" & i
        Next i
        For i = Say3 + 1 To Say
            ReDim Preserve Liste3(1 To 7, 1 To i)
            Liste3(1, i) = "VERİ" & i
        Next i
        Range("D:XFD").HorizontalAlignment = xlHAlignCenter
        Range(Cells(9, 4), Cells(9, Say)).Interior.Color = Range("B12").Interior.Color
        Range(Cells(20, 4), Cells(20, Say)).Interior.Color = Range("B12").Interior.Color
        Range(Cells(30, 4), Cells(30, Say)).Interior.Color = Range("B12").Interior.Color
        Range(Cells(9, 2), Cells(15, Say)).BorderAround xlContinuous, xlMedium
        Range(Cells(20, 2), Cells(26, Say)).BorderAround xlContinuous, xlMedium
        Range(Cells(30, 2), Cells(36, Say)).BorderAround xlContinuous, xlMedium
End Sub

 

[Lokmanx]

Ömer Faruk Bey çok teşekkür ederim.

Gayet güzel olmuş ellerinize sağlık. Peki sadece Kod ile arama yapmak istersem ne yapmam gerekir.

Örnek dosyamızda KOD-HESAP ADI ve IBAN alanları dolu olursa 3 tabloyada veri getiriyor ama örneğin sadece KOD ile arama yapmak istersem hata veriyor. Bu konuda nasıl bir düzenleme yapabiliriz.

 

[ÖmerFaruk]

Sub KosulluVeriGetir()
    Dim Liste1(), Liste2(), Liste3(), Say1 As Integer, Say2 As Integer, Say3 As Integer, i As Long
    Veri = Worksheets("Data").Range("A1").CurrentRegion.Value
    Range("D:XFD").Clear
    For i = 2 To UBound(Veri)
        If Range("C3") = Veri(i, 2) Then
            Say1 = Say1 + 1
            ReDim Preserve Liste1(1 To 7, 1 To Say1)
            Liste1(1, Say1) = "VERİ" & Say1
            Liste1(4, Say1) = Veri(i, 3)
            Liste1(5, Say1) = Veri(i, 6)
            Liste1(6, Say1) = Veri(i, 8)
            Liste1(7, Say1) = Veri(i, 9)
        End If
    Next i
    Range("D9").Resize(7, Say1) = Liste1
    Range("D20").Resize(7, Say2) = Liste2
    Range("D30").Resize(7, Say3) = Liste3
    Say = WorksheetFunction.Max(Say1, Say2, Say3) + 3
    Range("D:XFD").HorizontalAlignment = xlHAlignCenter
    Range(Cells(9, 4), Cells(9, Say)).Interior.Color = Range("B12").Interior.Color
    Range(Cells(9, 2), Cells(15, Say)).BorderAround xlContinuous, xlMedium
End Sub

 

[Lokmanx]

Merhaba Ömer Faruk Bey,

Bu veriler ile hata alıyorum çalışmıyor sistem. Kontrol etmeniz mümkün mü acaba

 

[ÖmerFaruk]

Range("D20").Resize(7, Say2) = Liste2
Range("D30").Resize(7, Say3) = Liste3

Bu iki satırı silmeyi unutmuşum.

 

[Lokmanx]

Sildim ama yine olmadı hocam ben bir yerde hata yapıyorum sanırım.

Dosya ekte yer alıyor . Burada sadece KOD yazan alana KOD-HESAP ADI veya IBAN yazarak altta yer alan 3 liste hangi veriyi girdiysem ona göre verileri dat dan getirmesi mümkün mü

 

[Lokmanx]

Halletim hocam teşekkür ederim