sayfadan iki satır ve sütun kriterine göre veri getirmek

[mbldn]

Arkadaşlar ve sayın hocalar merhaba;
yine çok takıldığım cins bir soru ile karşı karşıyayım. ekli dosyada göreceğiniz gibi amacaım birinci sayfaya b ve c sütununu dikkate alarak diğer sayfadan kesişen veriyi getirmek yardımcı olabilecek tüm arkadaşlara teşekkür ederim.

 

[hamitcan]

Aşağıdaki formülü kullanın.

=DOLAYLI(ADRES(KAÇINCI(C3;değerler!$A$1:$A$4;0);KAÇINCI(B3;değerler!$1:$1;0);;;"değerler"))

 

[mbldn]

Aşağıdaki formülü kullanın.

=DOLAYLI(ADRES(KAÇINCI(C3;değerler!$A$1:$A$4;0);KAÇINCI(B3;değerler!$1:$1;0);;;"değerler"))

Sayın Hamitcan Hocam;
ilginiz için çok teşekkür ederim. ancak makro ile yapmamız mümkün değil midir? ana sayfa ve değer sayfasında belki binleri bulacak veriler olacak. dosya boyutu çok büyüyebilir ya da çalışmayabilir diye düşünüyorum. bir de makro örneği verebilir misiniz? alternatif olarak
saygılar

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long
    Dim ÜRÜN_BUL As Range, ÜRÜN_ADRES As String, İL_BUL As Range
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("ANA SAYFA")
    Set S2 = Sheets("DEĞERLER")
    
    S1.Select
    Range("D3:D65536").ClearContents
    
    For X = 3 To Range("B65536").End(3).Row
        If Cells(X, 2) <> "" And Cells(X, 3) <> "" Then
            Set ÜRÜN_BUL = S2.Range("A:A").Find(Cells(X, 3), LookAt:=xlWhole)
            If Not ÜRÜN_BUL Is Nothing Then
            ÜRÜN_ADRES = ÜRÜN_BUL.Address
            Do
                Set İL_BUL = S2.Rows(1).Find(Cells(X, 2), LookAt:=xlWhole)
                If Not İL_BUL Is Nothing Then
                    Cells(X, 4) = S2.Cells(ÜRÜN_BUL.Row, İL_BUL.Column)
                End If
            Set ÜRÜN_BUL = S2.Range("A:A").Find(Cells(X, 3), ÜRÜN_BUL)
            Loop While Not ÜRÜN_BUL Is Nothing And ÜRÜN_BUL.Address <> ÜRÜN_ADRES
            End If
        End If
    Next
    
    Set İL_BUL = Nothing
    Set ÜRÜN_BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
        
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[mbldn]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long
    Dim ÜRÜN_BUL As Range, ÜRÜN_ADRES As String, İL_BUL As Range
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("ANA SAYFA")
    Set S2 = Sheets("DEĞERLER")
    
    S1.Select
    Range("D3:D65536").ClearContents
    
    For X = 3 To Range("B65536").End(3).Row
        If Cells(X, 2) <> "" And Cells(X, 3) <> "" Then
            Set ÜRÜN_BUL = S2.Range("A:A").Find(Cells(X, 3), LookAt:=xlWhole)
            If Not ÜRÜN_BUL Is Nothing Then
            ÜRÜN_ADRES = ÜRÜN_BUL.Address
            Do
                Set İL_BUL = S2.Rows(1).Find(Cells(X, 2), LookAt:=xlWhole)
                If Not İL_BUL Is Nothing Then
                    Cells(X, 4) = S2.Cells(ÜRÜN_BUL.Row, İL_BUL.Column)
                End If
            Set ÜRÜN_BUL = S2.Range("A:A").Find(Cells(X, 3), ÜRÜN_BUL)
            Loop While Not ÜRÜN_BUL Is Nothing And ÜRÜN_BUL.Address <> ÜRÜN_ADRES
            End If
        End If
    Next
    
    Set İL_BUL = Nothing
    Set ÜRÜN_BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
        
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sayın Korhan Ayhan ;
çok teşekkür ederim sayenizde iki alternatif çözümüm oldu.
elinize sağlık saygılar