karşılığını bul ve yaz...

[karakayalı]

dosya ektedir...kolay gelsin...

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki formülü denermisiniz.

=EĞER(DÜŞEYARA(A1;Sayfa1!$A$1:$B$23;2;0)=0;"";EĞER(EYOKSA(DÜŞEYARA(A1;Sayfa1!$A$1:$B$23;2;0));"";DÜŞEYARA(A1;Sayfa1!$A$1:$B$23;2;0)))

 

[karakayalı]

evet işimi gördü ancak bunu makro ile yapabilrmiyiz...tşk.

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub aktar()
Dim k As Range
Set s2 = Sheets("Sayfa2")
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
s2.Range("B1:B65536").ClearContents
For i = 1 To Cells(65536, "B").End(xlUp).Row
    If Cells(i, "B").Value <> "" Then
        Set k = s2.Range("A1:A65536").Find(Cells(i, "A").Value, , xlValues, xlWhole)
        s2.Cells(k.Row, "B").Value = Cells(i, "B").Value
    End If
Next i
Application.ScreenUpdating = True
MsgBox "Aktarma tamamlandı..!!"
End Sub

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub KARŞILAŞTIR_YAZ()
    For X = 1 To [A65536].End(3).Row
    Set BUL = Sheets("Sayfa2").[A:A].Find(Cells(X, 1), LookAt:=xlWhole)
    If Not BUL Is Nothing Then
    Sheets("Sayfa2").Cells(BUL.Row, 2) = Cells(X, 2)
    End If
    Next
    Set BUL = Nothing
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[1Al2Ver]

Sayın Cost_Control tarafından yazılan kod 1 nolu msj.daki dosyaya eklendi, denermisiniz.

Sub KARŞILAŞTIR_YAZ()
    For X = 1 To [A65536].End(3).Row
    Set BUL = Sheets("Sayfa2").[A:A].Find(Cells(X, 1), LookAt:=xlWhole)
    If Not BUL Is Nothing Then
    Sheets("Sayfa2").Cells(BUL.Row, 2) = Cells(X, 2)
    End If
    Next
    Set BUL = Nothing
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

NOT; 1 buton eklendi, gerekirse iptal edin....

 

[1Al2Ver]

sayın Orion2 nin ek'li dosyası da çalışmaktadır ve bir buton içermektedir,
hangisini isterseniz onu kullanınız, ben de emeği geçen her iki ustaya bu vesile ile bir kez daha teşekkür etmek istiyorum, sağolsunlar, saygılarımla.

 

[karakayalı]

teşekkürler...

 

[teknikyapı]

merhaba.fonksiyon ile çözümde aşağıdaki formülü denermisiniz..

=EĞER(DÜŞEYARA(A1;Sayfa1!$A$1:$B$23;2;0)=0;"";DÜŞEYARA(A1;Sayfa1!$A$1:$B$23;2;0))

 

[nesmeh]

İlgili Örnek ilişiktedir

Umarım öğrenmek istediğiniz budur.

 

[karakayalı]

yukarıdaki kod normal olarak çalışıyor...ancak sayfa2 de mükerrer olanlardan sadece bir tanesinin karşısına yazıyor...ben istiyorumki sayfa2de mükerrer olanların isimlerin karşısınada yazsın...bunun için kod da nasıl bir değişiklik yapmalıyız..kolay gelsin...

 

[karakayalı]

bir fikri olan arkadaş yokmu?

 

[karakayalı]

dosya ektedir..kolay gelsin..

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu kullanabilirsiniz.

Option Explicit
 
Sub KARŞILAŞTIR_YAZ()
    Dim X As Integer, BUL As Range, ADRES As String
    Dim S1 As Worksheet, S2 As Worksheet
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
    For X = 1 To S1.[A65536].End(3).Row
        Set BUL = S2.[A:A].Find(S1.Cells(X, 1), LookAt:=xlWhole)
        If Not BUL Is Nothing Then
            ADRES = BUL.Address
            Do
                S2.Cells(BUL.Row, 2) = S1.Cells(X, 2)
                Set BUL = S2.[A:A].FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
    Next
 
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[karakayalı]

sayın korhan ayhan, emeğinize teşekkürler...mükemmel olmuş...sağolasın...