Çoklu bul,getir

[ADER_34]

Merhaba örnek dosyamda "ARANAN" sayfasındaki veriyi tüm sayfalarda ara eşleşen
değeri bul, RAF numarasını RAF-1 RAF-2 RAF-3 şeklinde sütunlara yazdır mümkünmü? kolay gelsin teşekkürler..

http://www.dosya.tc/server11/784yvi/COKLU_SECENEK.rar.html

 

[leumruk]

Selamalar,
Eklediğim kodu dosyanızın Aranan sayfasının kod bölümüne kopyalayın. Konuyu makro bölümünde açtığınız için kod olarak ekliyorum. Ama çalışmanız formülle kolaylıkla çözülebilecek özellikte. Yine de tercih sizin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:a1000")) Is Nothing Then Exit Sub
Range("c" & Target.Row & ":e" & Target.Row).ClearContents
sat1 = Sheets("Sayfa1").Cells(Rows.Count, 1).End(3).Row
sat2 = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
sat3 = Sheets("Sayfa3").Cells(Rows.Count, 1).End(3).Row

Cells(Target.Row, 3) = Evaluate("=VLOOKUP(" & Target & ",Sayfa1!a2:c" & sat1 & ",3,0)")
Cells(Target.Row, 4) = Evaluate("=VLOOKUP(" & Target & ",Sayfa2!a2:c" & sat2 & ",3,0)")
Cells(Target.Row, 5) = Evaluate("=VLOOKUP(" & Target & ",Sayfa3!a2:c" & sat3 & ",3,0)")
End Sub

 

[ADER_34]

Merhaba Sayın leumruk kodlarınız denedim sorunsuz fakat benim istediğim ARANAN sayfasındaki veriyi örnek "1234579" kaçtane raf no varsa RAF-1 RAF-2 RAF-2 RAF-4 RAF-5 gibi kaçtane raf numarası varsa getirmesini istiyorum bazı veriler hem mükerer hemde birden çok raf numarası var kolay gelsin..

 

[leumruk]

Selamlar,
Açıklamanızdan anladığım kadarıyla bir kodlama hazırladım. Bir modül oluşturup kodu kopyalayınız. Aranan sayfasında bir buton oluşturup makroyu o butona tanımlayınız.
Kodu çalıştırmadan önce Aradığınız numaraları Aranan sayfasının A sütununa yazınız.

Eğer istediğiniz bu değilse kod çalıştığı zaman nasıl bir sonuç almak istediğinizi gösteren bir dosya ekleyiniz.

NOT: Örnek dosya eklemek için Google.drive, yandex.drive gibi dosya saklama hesaplarını tavsiye ederim. Yine de tercih sizin tabi...

Sub Raf()
Range(Cells(2, 3), Cells(1000, 100)).ClearContents
For x = 2 To Cells(Rows.Count, 1).End(3).Row
Sut = 2
For y = 1 To 3
Set syf = Worksheets("Sayfa" & y)
sat = syf.Cells(Rows.Count, 1).End(3).Row
With syf.Range("a1:a" & sat)
Aranan = Cells(x, 1)
     Set c = .Find(Aranan, LookIn:=xlValues)
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
        Sut = Sut + 1
        Cells(x, Sut) = syf.Cells(c.Row, 3)
            Set c = .FindNext(c)
        Loop While c.Address <> firstAddress
      End If
End With
Next
Next
MsgBox "İşlem tamamlandı."
End Sub

 

[ADER_34]

Merhaba sayın Leumruk kodlarınızı denedim istediğim işlemi yapıyor sizden isteğim benim kendi dosyamda sayfa isimleri Sayfa1 Sayfa2 Sayfa3 sabit değil değişken Adlarda MB,LCD,gibi vs kodlar sayfa adlarında hata veriyor kodlarda nasıl bir ilave gerekli teşekkürler..

 

[leumruk]

Merhaba sayın Leumruk kodlarınızı denedim istediğim işlemi yapıyor sizden isteğim benim kendi dosyamda sayfa isimleri Sayfa1 Sayfa2 Sayfa3 sabit değil değişken Adlarda MB,LCD,gibi vs kodlar sayfa adlarında hata veriyor kodlarda nasıl bir ilave gerekli teşekkürler..

Makroyu çalıştırdığınız sayfa sonda olmak koşuluyla aşağıdaki kodu kullanabilirsiniz. Aradığınız sayfa sayısına göre "y" tanımlı döngünün sayısını artırabilirsiniz. Örneğin 3 yerine 5 vs. yazabilirsiniz. Daha esnek bir kodlama istiyorsanız, Dosyanızla ilgili ayrıntıları belirtmelisiniz. Örneğin: Sayfa sayısı değişebiliyor mu? Arama yapılan sayfalar ve Anasayfanız dışında başka sayfa var mı? Hangi sırada vs...
Benim size tavsiyem: Arama yapılan sayfalar dışındaki tüm sayfaları sona ya da başa almak...

Sub Raf()
Range(Cells(2, 3), Cells(1000, 100)).ClearContents
For x = 2 To Cells(Rows.Count, 1).End(3).Row
Sut = 2
For y = 1 To 3
Set syf = Worksheets(y)
sat = syf.Cells(Rows.Count, 1).End(3).Row
With syf.Range("a1:a" & sat)
Aranan = Cells(x, 1)
     Set c = .Find(Aranan, LookIn:=xlValues)
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
        Sut = Sut + 1
        Cells(x, Sut) = syf.Cells(c.Row, 3)
            Set c = .FindNext(c)
        Loop While c.Address <> firstAddress
      End If
End With
Next
Next
MsgBox "İşlem tamamlandı."
End Sub

 

[ADER_34]

Merhaba sayın leumruk kodlarınızı denedim sayfa sayısını elle değiştirince hata vermedi kodlar çalıştı fakat "ARANAN" sayfasında sonuç şöyle oldu bir ürüne "35" tane hücre de raf no verilmiş "mükerrer"yada farklı olarak,fakat mükerrer olanları çıkarınca raf no 6 adet oldu size zahmet olmazsa sonuç getirirken mükerer rafları getirmeyip raf no larını teke düşürerek getirirsem tam istdiğim olacak kolay gelsin teşekkürler..

 

[leumruk]

Merhaba,

Sub Raf()
Range(Cells(2, 3), Cells(1000, 200)).ClearContents
For x = 2 To Cells(Rows.Count, 1).End(3).Row
Sut = 2
For y = 1 To 3
Set syf = Worksheets(y)
sat = syf.Cells(Rows.Count, 1).End(3).Row
With syf.Range("a1:a" & sat)
Aranan = Cells(x, 1)
     Set c = .Find(Aranan, LookIn:=xlValues)
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
        say = WorksheetFunction.CountIf(Range(Cells(x, 3), Cells(x, 200)), syf.Cells(c.Row, 3))
        If say = 0 Then
        Sut = Sut + 1
        Cells(x, Sut) = syf.Cells(c.Row, 3)
        End If
            Set c = .FindNext(c)
        Loop While c.Address <> firstAddress
      End If
End With
Next
Next
MsgBox "İşlem tamamlandı."
End Sub