Makro ile üç veriyi düşeyara ile bulmak

[Hacı Bayram ÖZKAN]

Merhabalar; arkadaşlar; Ekli dosyamda seçime göre TANIMLAR sayfasındaki verileri düşeyara yöntemi ile almak istiyorum, forumdan bir kod buldum, ancak sadece birini alabildim, ancak ben yapacağım seçimle 3 veriyi almak istiyorum. Teşekkürler.

 

[Ömer]

Merhaba,

=DÜŞEYARA(F9;TANIMLAR!B:D;2;0)

formülü ile alabilirsiniz. 2 yerine 3 yazarsanız D sütunundaki veriyi alırsınız.

 

[Ömer]

Makro istemişsiniz sanırım.

Sayfanın kod bölümüne;

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [F9:F18]) Is Nothing Then Exit Sub
 
    Dim c As Range, St As Worksheet
 
    Set St = Sheets("TANIMLAR")
 
    With Target
        Set c = St.Range("B:B").Find(.Value, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Cells(.Row, "L") = St.Cells(c.Row, "D")
            Cells(.Row, "M") = St.Cells(c.Row, "C")
        Else
            Cells(.Row, "L") = "Bulunamadı.."
            Cells(.Row, "M") = ""
        End If
    End With

End Sub

 

[Hacı Bayram ÖZKAN]

Ömer abi eline sağlık çok güzel oldu abim, birde abi A9 dan başlayıp her işlem için sıra numarası makro ile eklenir mi yani ben bunu =EĞER(F9="";"";BAĞ_DEĞ_DOLU_SAY($F$9:F9)) bu formül ile yapmıştım, bu formülde makro olarak yazdığınız makroya dahil edilebilir mi teşekkürler.

 

[Ömer]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [F9:F18]) Is Nothing Then Exit Sub
 
    Dim c As Range, St As Worksheet, i As Byte, sat As Byte
 
    Set St = Sheets("TANIMLAR")
 
    With Target
        Set c = St.Range("B:B").Find(.Value, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Cells(.Row, "L") = St.Cells(c.Row, "D")
            Cells(.Row, "M") = St.Cells(c.Row, "C")
        Else
            Cells(.Row, "L") = "Bulunamadı.."
            Cells(.Row, "M") = ""
        End If
    End With
    
    [A9:A18] = ""
    sat = 1
    For i = 9 To 18
        If Cells(i, "F") <> "" Then
            Cells(i, "A") = sat
            sat = sat + 1
        End If
    Next i

End Sub

 

[Hacı Bayram ÖZKAN]

Abim çok teşekkür ederim, eline sağlık dua ile kal Hayırlı Ramazanlar