• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Bir Hücredeki verileri ayrı ayrı sütun getirme Çok ACİL Lütfen

Katılım
11 Mayıs 2011
Mesajlar
17
Excel Vers. ve Dili
türkçe excel 2010
Merhabalar A sütununda bulunan verilerden sadece e-mail adreslerini almak istiyorum . Uğraştım ancak yapamdım .Yardımcı olursanız çok makbule geçer
 

Ekli dosyalar

Merhabalar A sütununda bulunan verilerden sadece e-mail adreslerini almak istiyorum . Uğraştım ancak yapamdım .Yardımcı olursanız çok makbule geçer

Alternatif olsun
Kod:
Option Explicit
Sub mailleri_al()
'Konu       :   Maiileri Al
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As String, a As String, b As Long
On Error GoTo 1967
Application.ScreenUpdating = False
Range("B:B").ClearContents
For b = 2 To Cells(Rows.Count, "A").End(xlUp).Row
kral = ""
For asi = InStr(1, Cells(b, "A"), "@") To 1 Step -1
If Mid(Cells(b, "A"), asi, 1) = " " Then
If kral = "" Then
kral = Mid(Cells(b, "A"), asi + 1, Len(Cells(b, "A")))
End If: End If: Next
If kral <> "" Then
For asi = InStr(1, kral, ".") To Len(kral)
If Mid(kral, asi, 1) = " " Then
a = Replace(kral, Mid(kral, asi + 1, Len(kral)), "")
End If: Next
Cells(b, "B") = Replace(a, " ", "")
End If:
1967:
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
Boş module kopyalayın ve deneyin. Dosyanız Ekte.
 

Ekli dosyalar

Geri
Üst