• DİKKAT

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

Düşeyara fonksiyonu ile aynı kişiye ait birden fazla kaydı listelemek

  • Konbuyu başlatan Konbuyu başlatan rayko
  • Başlangıç tarihi Başlangıç tarihi
Tahsinanarat kardeşim çok güzel ellerine sağlık emeğine sağlık :)
 
Tahsinarat kardeşim;

Ben aynı işlevi ek'te ki dosya içinde yapmak istiyorum. Sayfa3 de firma numaralarının altına, sayfa2nin b sütunundaki numaralardan birini yazınca bilgiler çıkıyor.Ben önceki ekte olduğu gibi aynı olanların alt alta sıralanmasını ve kaldığım yerden kod girmeye devam etmesini istiyorum.Sabahdan beri önceki verdiğiniz kodlar üzerinde uğraştım beynim sulandı yapamadım sayenizde bunu da yaparsanız az çok mantığı kapmış olacam teşekkürler.

Dosya eki:

Ekli dosyayı görüntüle KİTAP.xls

..
 
Arkadaşım Sayfa2 de B4,B5,B6 daki formuller içindeki D8 Değerini D100 yaparsan Sayfa1 de97 adet giriş yaparsın.

Kod: 
=DÜŞEYARA(Sayfa2!B3;Sayfa1!A1:D8;2;YANLIŞ)
 
Son düzenleme:
vardar07 kardeşim o ekle sıkıntım yok yukarda yeni ek var KİTAP.xls onunla ilgili sıkıntım
 
rayko' Alıntı:
Tahsinarat kardeşim;

Ben aynı işlevi ek'te ki dosya içinde yapmak istiyorum. Sayfa3 de firma numaralarının altına, sayfa2nin b sütunundaki numaralardan birini yazınca bilgiler çıkıyor.Ben önceki ekte olduğu gibi aynı olanların alt alta sıralanmasını ve kaldığım yerden kod girmeye devam etmesini istiyorum.Sabahdan beri önceki verdiğiniz kodlar üzerinde uğraştım beynim sulandı yapamadım sayenizde bunu da yaparsanız az çok mantığı kapmış olacam teşekkürler.

Dosya eki:

Ekli dosyayı görüntüle 136476

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

çözüm bula bilen var mı ?
 
Dosyanız ekte

Datalarınız çoğaldıkça hesaplama süresi de bi o kadar artacaktır.
formüllerde sayfa2 den gelecek data satır sayısını 1000 olarak ayarladım, Sayfa3 de ise 101 satıra kadar formüller kopyalıdır, siz gerektiği kadar çekerek çoğaltınız.
 

Ekli dosyalar

Teşekkürederim kardeşim sayenizde birşeyler öğreniyorum vba kodları için eğitim setinden de yardım alıyorum inş öğrenirsem bende sizin gibi diğer kardeşlerime yardımcı olacam sayeniz de :)
 
selamunaleykum arkadaşlar..elimde iki tablo var .birisi stok diğeri üretim bekleyen ürünler..üretim bekleyen tabloda herhangibir ürün koduna ait ürünün stokta hangi ülkede ve ne kadar olduğuna bakacam fakat düşeyara sadece ilk gördüğü ülkenin adedini getiriyor ikinci veya üçüncü ülkelerde aynı ürün varsa onu görmüyor.bu konuda yardımcı olabilecek varmı?[URL=http://dosya.co/5c3fbisfh7dd/40.hafta_uretım_bekleyenler.v3.xlsx.html]40.hafta uretım bekleyenler.v3.xlsx - 468 KB[/URL]
[URL=http://dosya.co/q6idx49fptzf/STOK_30.09.xlsx.html]STOK 30.09.xlsx - 125 KB[/URL]
 
Merhaba,
Öncelikle aranıza yeni katılmış olmanın mutluluğunu yaşıyorum.
Sorunum ise şu; örnek eklediğim excelde fidan kısmına; "ağaç" sayfasından verileri getirsin istiyorum. Ancak bu sayfada Ali Balcı ismi 3 defa yazmak zorunda, diğer sayfada Ali Balcı 2 yerde var, 2si yazsın 3.sü boş olsun. Diğer yandan Ali Demir bu sayfada 3 tane var diğer sayfada 5 tane var, 5 veri de buraya gelsin istiyorum.
Teşekkür ederim.
 

Ekli dosyalar

Merhaba,

Sonuç olarak görmek istediğiniz tabloyu örnek dosyanıza ekleyip paylaşırsanız yanıt almanız daha da hızlanacaktır.
 
Paylaştığınız örnek dosyada ALİ DEMİR kişisi 6 satırda geçiyor. Siz 5 satırlık bilgiyi diğer sayfada göstermişsiniz.

Her kişi için maksimum 5 satır mı göstermek istiyorsunuz?
 
Deneyiniz.

C++: 
Option Explicit

Sub Tablolari_Birlestir()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Veri As Variant, X As Long, Say As Long
    Dim Bul As Range, Adres As String
    Dim WF As WorksheetFunction, Sayac As Long
    Dim Say_1 As Long, Say_2 As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set S1 = Sheets("veri")
    Set S2 = Sheets("ağaç")
    Set WF = WorksheetFunction
    
    Veri = S1.Range("A2:E" & S1.Cells(S1.Rows.Count, 1).End(3).Row).Value
    
    ReDim Liste(1 To S1.Rows.Count, 1 To 5)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 1) <> "" Then
            Say_1 = WF.CountIf(S1.Range("C:C"), Veri(X, 3))
            Say_2 = WF.CountIf(S2.Range("C:C"), Veri(X, 3))
            If Say_1 > 0 And Say_2 > 0 Then
                Set Bul = S2.Range("C:C").Find(Veri(X, 3), , , xlWhole)
                If Not Bul Is Nothing Then
                    Adres = Bul.Address
                    Do
                        If Bul.Offset(, 3) = "" Then
10                          Say = Say + 1
                            Sayac = Sayac + 1
                            Liste(Say, 1) = Veri(X, 1)
                            Liste(Say, 2) = Veri(X, 2)
                            Liste(Say, 3) = Veri(X, 3)
                            If Not Bul Is Nothing Then
                                Liste(Say, 4) = Bul.Offset(, 1)
                                Liste(Say, 5) = Bul.Offset(, 2)
                                Bul.Offset(, 3) = "X"
                            End If
                        End If
                        If Bul Is Nothing Then Exit Do
                        Set Bul = S2.Range("C:C").FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adres
                    If Sayac < Say_1 And Say_2 < Say_1 Then
                        Set Bul = Nothing
                        GoTo 10
                    End If
                    Sayac = 0
                    X = X + Say_1 - 1
                End If
            Else
                Say = Say + 1
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = Veri(X, 2)
                Liste(Say, 3) = Veri(X, 3)
                Liste(Say, 4) = "YOK"
                Liste(Say, 5) = "YOK"
            End If
        End If
    Next

    S1.Range("A2:E" & S1.Rows.Count).ClearContents
    S1.Range("A2").Resize(Say, 5) = Liste
    S2.Range("F:F").ClearContents

    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Deneyiniz.

C++: 
Option Explicit

Sub Tablolari_Birlestir()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Veri As Variant, X As Long, Say As Long
    Dim Bul As Range, Adres As String
    Dim WF As WorksheetFunction, Sayac As Long
    Dim Say_1 As Long, Say_2 As Long
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Set S1 = Sheets("veri")
    Set S2 = Sheets("ağaç")
    Set WF = WorksheetFunction
   
    Veri = S1.Range("A2:E" & S1.Cells(S1.Rows.Count, 1).End(3).Row).Value
   
    ReDim Liste(1 To S1.Rows.Count, 1 To 5)
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 1) <> "" Then
            Say_1 = WF.CountIf(S1.Range("C:C"), Veri(X, 3))
            Say_2 = WF.CountIf(S2.Range("C:C"), Veri(X, 3))
            If Say_1 > 0 And Say_2 > 0 Then
                Set Bul = S2.Range("C:C").Find(Veri(X, 3), , , xlWhole)
                If Not Bul Is Nothing Then
                    Adres = Bul.Address
                    Do
                        If Bul.Offset(, 3) = "" Then
10                          Say = Say + 1
                            Sayac = Sayac + 1
                            Liste(Say, 1) = Veri(X, 1)
                            Liste(Say, 2) = Veri(X, 2)
                            Liste(Say, 3) = Veri(X, 3)
                            If Not Bul Is Nothing Then
                                Liste(Say, 4) = Bul.Offset(, 1)
                                Liste(Say, 5) = Bul.Offset(, 2)
                                Bul.Offset(, 3) = "X"
                            End If
                        End If
                        If Bul Is Nothing Then Exit Do
                        Set Bul = S2.Range("C:C").FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adres
                    If Sayac < Say_1 And Say_2 < Say_1 Then
                        Set Bul = Nothing
                        GoTo 10
                    End If
                    Sayac = 0
                    X = X + Say_1 - 1
                End If
            Else
                Say = Say + 1
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = Veri(X, 2)
                Liste(Say, 3) = Veri(X, 3)
                Liste(Say, 4) = "YOK"
                Liste(Say, 5) = "YOK"
            End If
        End If
    Next

    S1.Range("A2:E" & S1.Rows.Count).ClearContents
    S1.Range("A2").Resize(Say, 5) = Liste
    S2.Range("F:F").ClearContents

    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...
Maksimum 5 satır olacak şekilde yapmışsınız sanırım.
Ellerinize sağlık çok teşekkür ederim.
 
Bir satır sınırlaması koymadım. "ağaç" isimli sayfanızda eğer en fazla 5 satırlık blok içeren veri varsa ona göre kod o sebeple 5 satırlık sonuç veriyordur.

Mesela denemek için ALİ DEMİR verisini "ağaç" sayfasında 10 satır çoğaltarak kodu çalıştırdığınızda 10 satırlık veriyi aldığını görebilirsiniz.
 
Merhabalar birden çok veriyi ayni hücrede yazdırabilir miyiz.
 
Evet yazdırabilirsiniz..
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst