Mail adresleri firma eşleştirme

[quadran]

Merhaba benim sorunum bana göre çok karışık ama size nasıl gelir bilmem.

1- eğer info@sirketismi.com diye başlıyorsa
2- ya da şirketismi@hotmail.com diye başlıyorsa

şirket ismini 2. tablo' daki şirket ismi ile karşılaştıracak eğer tutuyorsa yanına mail adresini yazacak.

 

[Necdet]

Merhaba,

Kodlar daha kısa yazılabilirdi ama, bir deneyiniz.

Public Sub emaibul()
On Error Resume Next
Set s1 = Sheets("email liste")
Set s2 = Sheets("şirket liste")
s2.Range("E2:E65536").ClearContents
For i = 2 To s1.[A65536].End(3).Row
    j = 0
    j = Application.WorksheetFunction.Search("@", Cells(i, "A"))
    If j > 0 Then
        Firma = Left(Cells(i, "A"), j - 1)
        Set Bul = s2.Columns(2).Find(Firma)
        If Not Bul Is Nothing Then s2.Range("E" & Bul.Row) = s1.Cells(i, "A")
    End If
Next i
For i = 2 To s1.[A65536].End(3).Row
    j = 0
    j = Application.WorksheetFunction.Search("@", Cells(i, "A"))
    If j > 0 Then
        k = Application.WorksheetFunction.Search(".", Cells(i, "A"))
        Firma = Mid(Cells(i, "A"), j + 1, k - j - 1)
        MsgBox Firma
        Set Bul = s2.Columns(2).Find(Firma)
        If Not Bul Is Nothing Then s2.Range("E" & Bul.Row) = s1.Cells(i, "A")
    End If
Next i
End Sub

 

[quadran]

Merhaba verdiğiniz tüyo için teşekkürler...

Yaptığınız uygulama isteklerimi tam olarak karşılamasada ilk adım için çok iyi söylediğimi karşılıyor.

Ayırma işlemini biraz daha detaylı hale getirmek gerekiyor sanırım.

Çok çok teşekkür ederim vakit ayırdığınız için. Gerçekten hoş olmuş.