Birden Fazla Değeri Eşleştirme

[husocan005]

Arkadaşlar merhaba;

Yardımlarınızı bekliyorum tabloda gerekli açıklamalar mevcuttur.


http://dosya.co/gvol2cid6efx/Deneme.xlsx.html

 

[husocan005]

arkadaşlar yanlışlık yapmıştım düzelttim bakabilirmisiniz.

 

[muygun]

NOT: Dosya değiştirildiği için çözümler kaldırıldı.

 

[husocan005]

muygun hocam ilgin için teşekkür ederim ama sonraki gönderdiğime linke bakabilirmisin ilk gönderdiğim yanlıştı.

http://dosya.co/gvol2cid6efx/Deneme.xlsx.html

 

[husocan005]

muygun hocam olmuyor mu peki

 

[Ziynettin]

Merhaba;

Kodu deneyiniz.

Option Explicit
Sub elestir()
Dim s1 As Worksheet, s2 As Worksheet, deg
Dim a(), b(), c(), d As Object, i As Long

Set s1 = Sheets("ANALYZER")
Set s2 = Sheets("EPİAŞ")
Set d = CreateObject("scripting.dictionary")

a = s1.Range("A2:C" & s1.Range("A" & Rows.Count).End(3).Row)
For i = 1 To UBound(a)
    deg = a(i, 1) & a(i, 2)
    d(deg) = a(i, 3)
Next i

b = s2.Range("A2:B" & s2.Range("A" & Rows.Count).End(3).Row)
ReDim c(1 To UBound(b), 1 To 1)
For i = 1 To UBound(b)
    deg = b(i, 1) & b(i, 2)
    c(i, 1) = d(deg)
Next i

s2.[D2].Resize(UBound(b)) = c
MsgBox "İşlem bitti...", vbInformation
End Sub

 

[muygun]

Merhaba;
Alternatif olsun.
İnceleyin.
İyi çalışmalar.

Link:
http://www.dosya.tc/server10/r9tlae/husocan005-Deneme.zip.html

 

[husocan005]

Ziynettin ve muygun hocalarım biraz geç cevap verdim ama teşekkür ederim ilginiz için.