Kritere göre bilgi getirtmek

[sakoz]

Arkadaşlar merhaba ,

Ekteki dosyada bazı datalarımız var.
Dosyada Sayfa1,Sayfa2 ve GENEL sheetlerimiz var. Sayfa1 ve Sayfa2 dataları ayrı yerlerden alınmaktadır. Sayfa1 de Müşteri , Ay ve Bayi sütunları var. Sayfa2 de yine müşteri , telefon ve bayi sütunları var.

GENEL sheetinde ise , bir tablomuz var. Burada şunu yapmak istiyoruz.

GENEL sheetine Müşteri bilgisi , bayisi , aylardaki rakamları ve telefon bilgisini getirtmek istiyoruz. Telefon bilgisi haric digerlerini manuel olarak kopyalıyoruz.
Telefon bilgisinide DÜŞEYARA ile getirtmeye çalışıyoruz. Fakat müşteri adı aynı oldugu zaman öncekinin telefon bilgisini getiriyor.Kısacası yanlış telefon bilgisi getiriyor. Burada hem müşteri hemde o müşterinin bayisini kontrol ederek telefon bilgisini nasıl getirtebiliriz. Yardımlarınız icin şimdiden teşekkürler.

Saygılar.

 

[Orion1]

Dosyanız ektedir.

Sub telefon()
Dim k As Range, adr As String, i As Long
Sheets("Genel").Select
Application.ScreenUpdating = False
Sheets("GENEL").Range("D2:D" & Cells(65536, "D").End(xlUp).Row).Clear
sat2 = 2
sat = Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row
For i = 2 To Cells(65536, "C").End(xlUp).Row
    Set k = Sheets("Sayfa2").Range("A2:A" & sat).Find(Cells(i, "C").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            If k.Offset(0, 2).Value = Cells(i, "B").Value Then
                Cells(i, "D").Value = k.Offset(0, 1).Value
                sat2 = sat2 + 1
                Exit Do
            End If
            Set k = Sheets("Sayfa2").Range("A2:A" & sat).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
      End If
Next i
Application.ScreenUpdating = True
MsgBox "Telefonlar yerleştirildi." & vbLf & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[Orion1]

Pardon.Teknik bir arıza olmuştu.Onu düzelttim.Önceki mesajdan indirebilirsiniz.

 

[sakoz]

Evren Bey ,

Çok teşekkür ederim..Tam istediğimiz gibi olmuş. Ellerinize sağlık.
İyiki varsınız