excelde 1 sayfadaki kelimeyi diger sayfalarda bulmak

[cemilc_comert]

iyi akşamlar arkadaşlar ; yardıma ihtiyacım var yardımcı olabilirseniz sevinirim.. ekteki excel dosyasında SAYFA-1 yer alan kelimenin SAYFA-2 de kelimelerin arasında aratarak karşılığı var ise SAYFA-2 deki ilgili sütunda karşılığını yazmasını istiyorum.. kafa yordum ama bilgim yetmedi.. cevaplarınız için teşekkürler

 

[dEdE]

Merhaba,
Ekli dosysyı inceler misiniz?

Sub bulYaz()
Set s1 = Sheets("SAYFA-1")
son = s1.[A65536].End(3).Row
For i = 1 To son
    Set BUL = Sheets("SAYFA-2").Cells.Find(s1.Cells(i, 1).Value, , , xlPart, , xlNext)
    If Not BUL Is Nothing Then
        Sheets("SAYFA-2").Cells(BUL.Row, 2).Value = s1.Cells(i, 1).Value
    End If
Next
MsgBox "İşlem Tamamlandı...", , "dEdE başarılar diler..."
End Sub

 

[tahsinanarat]

Sn. dEdE, Sayfa1 de a sutununda aranan kelimelirin bulunduğu sayfa2 deki butun satırların b sutununa yazdırılması mümkünmüdür. Verediğiniz örnekte bulduğu ilk satıra aranan değeri yazıyor.

 

[cemilc_comert]

Sn dEdE ilginiz ve cevabınız için çok teşekkürler dosya çok işime yaradı..kullandım ve bundan sonrası içinde kullanacağım tekrardan teşekkürler

 

[dEdE]

Sn. dEdE, Sayfa1 de a sutununda aranan kelimelirin bulunduğu sayfa2 deki butun satırların b sutununa yazdırılması mümkünmüdür. Verediğiniz örnekte bulduğu ilk satıra aranan değeri yazıyor.

Merhaba,
Sayın tahsinanarat, aşağıdaki kod istediğinizi yapar.

Sayın cemilc_comert, kodu yazarken SAYFA-2 deki verilerin mükerrer olmadığını varsaymıştım. Sayın tahsinanarat'ın uyarısı üzerine verilerinizi incelediğimde mükerrer kayıtlar olduğunu gördüm. Bu durumda muhtemelen sizin de aşağıdaki kodu kullanmanız gerekecek.
Hoşçakalın.

Sub bulYaz()
Set s1 = Sheets("SAYFA-1")
son = s1.[A65536].End(3).Row
For i = 1 To son
    Set bul = Sheets("SAYFA-2").Cells.Find(s1.Cells(i, 1).Value, , , xlPart, , xlNext)
    If Not bul Is Nothing Then
        adres = bul.Address
        Do
            Sheets("SAYFA-2").Cells(bul.Row, 2).Value = s1.Cells(i, 1).Value
            Set bul = Sheets("SAYFA-2").Cells.FindNext(bul)
        Loop While Not bul Is Nothing And bul.Address <> adres
    End If
Next i
End Sub

 

[tahsinanarat]

Sn. dEdE, ilginiz için çok teşekkür ediyorum. Bende aşağıdaki şekilde bir çözüm bulmuştum boşa gitmesin bari

Option Explicit
Sub ADRES_ARA()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, BUL As Range, ADRES As String
    Application.ScreenUpdating = False
    Set S1 = Sheets("Sayfa-1")
    Set S2 = Sheets("Sayfa-2")
    On Error Resume Next
    S2.ShowAllData
    On Error GoTo 0
    S2.Range("B2:B" & Rows.Count).ClearContents
    For X = 2 To S1.Cells(Rows.Count, 1).End(3).Row
        Set BUL = S2.Range("C:C").Find(S1.Cells(X, 1), , , xlPart)
        If Not BUL Is Nothing Then
            ADRES = BUL.Address
            Do
                BUL.Offset(0, -1) = S1.Cells(X, 1)
            Set BUL = S2.Range("C:C").FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
    Next
    'S1.Range("A1").AutoFilter Field:=3, Criteria1:="X"
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    Application.ScreenUpdating = True
    MsgBox "Bulma ve yazma işlemi tamamlanmıştır.", vbInformation
End Sub