iki sütundaki verilere göre vlookup yaparak diğer sheetten veri getirme(makro)

[u.L.a.s]

Merhaba

Aşağıdaki sorumu makro düzeneğinde olsun istiyorum.

sheet1 de G ve H sütunlarında bazı veriler var.
Sheet2 de ise a sütununda sheet1 deki g ve h sütunundaki veriler mevcut. b sütununda ise sheet1 de karşısına gelecek veriler mevcut

Eğer G sütununda herhangi bir hücre boş veya 0 değeri içeriyorsa H sütunundaki veriye bakacak Vlookup yapar gibi sheet2 deki karşılığını getirecek

Eğer G sütununda 0 veya boş değerden başka farklı bir veri varsa sheet2 deki veriyle vlookup yaparak J sütununa karşılık verileri yazacak

aşağıdaki linkte örnek dosya mevcuttur

http://s4.dosya.tc/server3/uwuxx6/soru.rar.html

bilgi ve yardımlarınızı rica ederim

 

[YUSUF44]

Aşağıdaki formülü deneyiniz:

=EĞERHATA(EĞERHATA(DÜŞEYARA(Sheet1!G2;Sheet2!A1:B10;2;0);DÜŞEYARA(Sheet1!H2;Sheet2!A1:B10;2;0));"")

 

[u.L.a.s]

bu formülize düzeni if then else şeklinde makro olarak yapamıyormuyuz acaba

 

[Ziynettin]

Makrolu çözüm,

Sub Bul()
Sayfa1.Select
son1 = Sayfa1.Range("G:H").Find("*", , , , xlByRows, xlPrevious).Row
son2 = Sayfa2.Range("A" & Rows.Count).End(3).Row

a = Sayfa1.Range("G2:H" & son1)
ReDim b(1 To UBound(a), 1 To 1)
On Error Resume Next
For i = 1 To UBound(a)
    say = say + 1
    If a(i, 1) <> 0 And a(i, 1) <> "" Then
        b(say, 1) = WorksheetFunction.VLookup(a(i, 1), Sayfa2.Range("A1:B" & son2), 2, 0)
    Else
        b(say, 1) = WorksheetFunction.VLookup(a(i, 2), Sayfa2.Range("A1:B" & son2), 2, 0)
    End If
Next i
Range("J2:J" & Rows.Count).ClearContents
If say > 0 Then
    Range("J2").Resize(say) = b
End If
MsgBox "İşlem Bitti.", vbInformation
End Sub

 

[u.L.a.s]

Kodda G2:H10 satır arası gibi düşünmüşsünüz ama hem sheet1 de hem sheet2 de satırlar çok daha fazla. ve bu değişkenlik gösteriyor.

 

[Ziynettin]

Satır için gereken düzeltmeler yapıldı kodu tekrar deneyiniz.