isimden mail oluşturma

[vivaayew_ts]

Merhabalar
İş yerinde herkese aynı formatta mail oluşturuldu, bunların programa kaydetmem gerekiyor, excel bir sütunda sıralarsam direk kayıt olabilirmiş
İstediğim misal kendim için (türkçe karakterleri değiştir yaparak ben düzeltiyorum,)
coşkun sarı, coskun.sari@gmail.com
ali rıza korkmaz, aliriza.korkmaz@gmail.com

yani "isim" sonrasında "." sonrasında "soyisim" ve sonrasında @.........
Tek isimlilerde sorun yok ama 2 isimlilerde sorun yaşıyorum, 2 isimliler 2 ismide birleşik yazılması gerekiyor
bunun için bir formül yazabilir misiniz
Saygılarımla

 

[çıtır]

Verilerinizin A2 Hücresinden başladığı varsayılmıştır.Kopyalayınız aşağı doğru çoğaltınız.Excel versiyonunuzda veri sekmesinde hızlı doldurma var ise, bu özellikle formül kullanmadan yapabilirsiniz.

=EĞERHATA(YERİNEKOY(YERİNEKOY(YERİNEKOY(YERİNEKOY(YERİNEKOY(YERİNEKOY(YERİNEKOY(KÜÇÜKHARF(KIRP(SOLDAN(YERİNEKOY(A2&" ";" ";YİNELE(" ";255);UZUNLUK(A2)-UZUNLUK(YERİNEKOY(A2;" ";"")));255))&"."&KIRP(PARÇAAL(A2;1+BUL("*";YERİNEKOY(A2;" ";"*";UZUNLUK(A2)-UZUNLUK(YERİNEKOY(A2;" ";""))));255)))&"@gmail.com";" ";"");"ı";"i");"ü";"u");"ö";"o");"ş";"s");"ç";"c");"ğ";"g");"")

 

[veyselemre]

Sub test()
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        al = StrReverse(Cells(i, 1).Value)
        bul = InStr(al, " ")
        If bul > 0 Then
            al = StrReverse(Replace(Left(al, bul - 1) & "." & Mid(al, bul + 1), " ", ""))
        Else
            al = StrReverse(al)
        End If
        Lst = Array("ğ", "g", "ı", "i", "ş", "s", "ö", "o", "ç", "c", "ü", "u")
        For ii = 0 To 10 Step 2
            al = Replace(al, Lst(ii), Lst(ii + 1))
        Next ii
        Cells(i, 2) = al & "@gmail.com"
    Next i
End Sub

 

[Mdemir63]

Selamlar
Veysel hocam
isimlerin ve soyisimlerin baş harfleri büyük kalıyor

 

[veyselemre]

coşkun sarı, coskun.sari@gmail.com
ali rıza korkmaz, aliriza.korkmaz@gmail.com

Kodlar soruya göre dizayn edildi.

Küçük harfe çevirmek için,

Sub test()
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        al = Evaluate("lower(""" & StrReverse(Cells(i, 1).Value) & """)")
        bul = InStr(al, " ")
        If bul > 0 Then
            al = StrReverse(Replace(Left(al, bul - 1) & "." & Mid(al, bul + 1), " ", ""))
        Else
            al = StrReverse(al)
        End If
        Lst = Array("ğ", "g", "ı", "i", "ş", "s", "ö", "o", "ç", "c", "ü", "u")
        For ii = 0 To 10 Step 2
            al = Replace(al, Lst(ii), Lst(ii + 1))
        Next ii
        Cells(i, 2) = al & "@gmail.com"
    Next i
End Sub

 

[Mdemir63]

Teşekkürler hocam

 

[vivaayew_ts]

Çok teşekkür ederim yardımlarınız için