Ayrı sayfada denkleştirme ?

[Gorarr]

Selamlar, burda yapmak istediğim Sayfa 1 ve Sayfa2 deki isimleri eşleştirmek.

Sütunların alfabetik sıralanıp, ilk harften itibaren alfabetik olarak en yakın denkleştirmeyi yapmam gerekiyor.

İşlem bittiğinde Ayrı bir sayfa oluşup (Sayfa3 deki gibi olması gerekiyor)

Yardımlarını için şimdiden çok çok teşekkürler...

 

[Gorarr]

Tekrar selamlar. Üstatlarım aceba soruma bakma fırsatınız olmadımı. Eğer çözüm yolu mümkün değilse konuyu kapatayım. Saygılar..

 

[leumruk]

Merhaba,
Sorunuza %100 çözüm bulmak zor. Ama şartları zorlayarak işinize yarayacak bir çözüm üretmeye çalıştım. Dosyayı kontrol edin, daha da geliştirmek gerekirse üzerinde çalışalım.
Butona bastığınızda benzer verileri Sayfa2'deki verilerin yanına aktaracaktır. Yanında isim olmayan veriler karşılığı bulunamayan verilerdir.

Sub denkleştir()
Dim knt As Boolean
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
SonSat = s2.[b65536].End(3).Row
s2.Range("c1:j" & SonSat).Clear
Set Aralik = s2.Range("b1:b" & s2.[b65536].End(3).Row)
Aralik.Sort Key1:=s2.Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
For w = 1 To [b65536].End(3).Row
    For q = 1 To 2
        For x = 1 To Len(Cells(w, 2))
            For y = 1 To Len(Cells(w, 2))
                Aranan = WorksheetFunction.Replace(Cells(w, 2), x, 1, "*")
                Aranan = WorksheetFunction.Replace(Aranan, y, q, "*")
                Set Bul = Aralik.Find(Aranan, LookIn:=xlValues, LookAt:=xlWhole)
                If Not Bul Is Nothing Then
                    s2.Cells(Bul.Row, s2.Cells(Bul.Row, 256).End(1).Column + 1) = Cells(w, 2)
                    knt = True: Exit For
                End If
            Next
            If knt = True Then Exit For
        Next
        If knt = True Then Exit For
    Next
    knt = False
    If Bul Is Nothing Then
    SonSat = SonSat + 1
        s2.Cells(SonSat, 3) = Cells(w, 2)
    End If
Next
MsgBox "Uygun kelimeler bulundu.", vbInformation, "l e u m r u k"
End Sub

 

[Gorarr]

Hocam öncelikle çok teşekkür ederim, ellerinize sağlık. Kodlar şöyle bir ekleme mümkünmü;

Bu sayfa3'deki karşılığı olmayan verilerde sayfa2'de uygun sütununda kalsa ve o sütuna göre alfabetik sıralama (seçimi genişletilmiş) yaptırtırsak tam istediğim gibi bir sonuç alıyorum.

Olmazsada o işlemi ellede yapabilirim. Tekrarda teşekkür ederim. Saygılar selamlar..

 

[leumruk]

Merhaba,
3 nolu mesajımdaki kodları ve dosyayı isteğiniz doğrultusunda güncelledim.

 

[Gorarr]

Hocam çok çok teşekkürler. Tam istediğim gibi oldu. Saygılar selamlar...