Soru makro ile düşeyara

[puslukurt]

Merhaba arkadaşlar;
bir excel sayfasında makro ile düşey arama yaptırmak istiyorum.
aranan değer : b3 hücresi
tablo dizisi : (D1:F20)
sutun indis sayısı : 3 (tablo dizisindeki f sutunundan bulacak
değerin yazılacağı hücre : b5
yardımlarınız için şimdiden teşekkür ederim.

 

[yanginci34]

pardon soruyu doğru okumamışım cevap silindi

 

[puslukurt]

yazdığınız formul olmadı ayrıca ben bu formülü vba da makro ile yapmak istiyorum. teşekkür ederim

 

[yanginci34]

Buyrun
http://dosya.co/5firsk663ml3/makro_düşeyara.xlsm.html

 

[bycakir]

isteğiniz doğrultusunda örnek bir çalışma yaptım dosya ektedir.
isterseniz dosyanızı paylasın ona ekleyelim.kullanılan kodlar aşağıdadır.

Sub DUSEYARA()
Dim isim As String
isim = InputBox("Aranacak Değeri Giriniz")
urun_miktari = Application.WorksheetFunction.VLookup(isim, Sayfa1.Range("D1:F20"), 3, False)
Sayfa1.Cells(5, 2) = urun_miktari
MsgBox "Aranan Değer B5 Hücresine Yazılmıştır.", vbInformation, "..:: Ömür ÇAKIR ::.."

End Sub

 

[puslukurt]

Buyrun
http://dosya.co/5firsk663ml3/makro_düşeyara.xlsm.html

Merhaba;
Öncelikle ilgi ve alakanıza çok teşekkür ederim. verdiğiniz linkden dosyayı indirdim. istediğim gibi olmuş. ancak kendi dosyama uyarladığım da hata veriyor hatanın sebebi ise (Private Sub Worksheet_Change(ByVal Target As Range) ile başlayan ve aşağıda yazdığım kod ile çakışma yapıyor. Buna nasıl bir çözüm bulabiliriz. sayfayı çalıştırdığımda (If Target = Cells(i, 4).Value Then) sarı renkde uyarı veriyor.
kodları ben kullandığım sayfanın kod bölümüne yazdım. ayrıca bir modül kullanmamıştım.

(DAHA ÖNCEDEN SAYFADA BULUNAN KOD)
Private Sub Worksheet_Change(ByVal Target As Range)


If Intersect(Target, Range("b3")) Is Nothing Then Exit Sub 'müşteri no"

With Sheets("müşteriler")
Set c = .Range("a:a").Find(Range("b3"), , xlValues, xlWhole) 'müşteri no"
If Not c Is Nothing Then
Range("c3") = .Cells(c.Row, "b") 'müşteri adı
Else
MsgBox "Hatalı Müşteri Numarası Girdiniz. Lütfen Kontrol Ediniz.", , "Murat Bozkurt"
Range("b3").ClearContents
Range("b4").Select
End If
End With

End Sub
(BU SİZİN YAZDIĞINIZ KOD)
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b3]) Is Nothing Then Exit Sub
Dim i
Dim son
son = Cells(Rows.Count, 4).End(3).Row
For i = 1 To son
If Target = Cells(i, 4).Value Then
Cells(5, 2).Value = Cells(i, 6).Value
End If
Next i
End Sub