exel tablosundaki mail adreslerini aynı sütüna toplamak

[mehmetyavuz]

Arkadaşlar exel tablomuzda bir ansiklopedi misali bilgi var her kelime ayrı hücrede.ve bu hucrelerin bazılarında mail adresleri var.mail adresi içeren hücreleri bir sütüna toplamak istiyorum yada mail adresi içermeyen hücrelerin hepsini silmek istiyorum.

10000 satır ve 20 sütün var.ornek tablo gozunuzde canlansın diye asagıda.

anlatabildim inşallah a-b-c-d sütunlarındaki mailleri e sütununa yazmak.


-----a-------------b---------------c-------------d------------- e
1--- ali ----- ali@mail.com ----- sdfgdfg ------ fgdfsg

2--- veli

3

4--- yusuf ----- sadfsdf -- yusuf@mail.com -- yhtyety
.
.
.

 

[Emir Hüseyin Çoban]

. . .

Merhaba.
Örnek dosya ile daha net çözümler üretilecektir.

. . .

 

[prmts]

Merhaba, veri isimli bir sayfa oluşturup alltaki koları verilerin olduğu sayfada çalıştırın.

Sub kontrolet()
Dim t As Long, s As Long
For t = 1 To 10000
If Right(Cells(t, 1).Value, 4) = ".com" Then s = s + 1: Sheets("veri").Cells(s, 1).Value = Cells(t, 1).Value
If Right(Cells(t, 2).Value, 4) = ".com" Then s = s + 1: Sheets("veri").Cells(s, 1).Value = Cells(t, 2).Value
If Right(Cells(t, 3).Value, 4) = ".com" Then s = s + 1: Sheets("veri").Cells(s, 1).Value = Cells(t, 3).Value
If Right(Cells(t, 4).Value, 4) = ".com" Then s = s + 1: Sheets("veri").Cells(s, 1).Value = Cells(t, 4).Value
Next t
End Sub

Yada formül isterseniz e2 hücresi için;

=EĞER(SAĞDAN(A2;4)=".com";A2;EĞER(SAĞDAN(B2;4)=".com";B2;EĞER(SAĞDAN(C2;4)=".com";C2;EĞER(SAĞDAN(D2;4)=".com";D2;""))))

 

[mehmetyavuz]

prmts ilk yazdıgının nasıl yapıldıgını tam anlamadım ama
formulle yapmak istedim.
e2 ye yapıstırdım ama calısmadı.
birde anladıgım kadarıyla sagdan .com olarak aratmıssın ama .com.tr gibi olanlarda var.
nasıl olucak bu yaa

 

[merakli_72]

örnek bir dosya ekleseydiniz,
muhtemelen sorununuz çoktan çözülmüştü
boylesı havanda su dovmek gibi

 

[mehmetyavuz]

örnek dosyayı ekledım.

 

[Murat OSMA]

Şu kodları deneyiniz;

Sub Emre()
    Dim Reg As Object
    Dim Evn As Range
    Application.ScreenUpdating = False
    Range("E1:E100").ClearContents
    Set Reg = CreateObject("VBScript.RegExp")
    Reg.Global = True
    Reg.Pattern = "[a-z-0-9]*(@\D*)"
    For Each Evn In Range("A1:D20")
        Set say = Reg.Execute(Evn.Value)
        If say.Count > 0 Then
           Range("E65536").End(3)(2, 1) = Reg.Execute(Evn.Value).Item(0)
        End If
    Next Evn
    Set Evn = Nothing: Set Reg = Nothing
End Sub

Ya da şu kodları;

Sub Emre()
    Dim Evn As Range
    For Each Evn In Range("A1:D20")
        If Evn.Value Like "*@*" Then
            Range("E65536").End(3)(2, 1) = Evn.Value
        End If
    Next Evn
    Set Evn = Nothing
End Sub

 

[merakli_72]

sayın murat bey


Range("E65536").End(3)(2, 1) = Evn.Value

satırındaki (2,1) ne anlama geliyor, rica etsem açıklayabilirmisiniz
ve mesela ilk mail adresini E2 değilde E1 yazdırmak istersek buraya ne yazmak gerekecek

 

[mehmetyavuz]

murat bey cevap için teşekkürler.fakat bu yazdıgınız kodları nereye eklıcez.makro bılmıyorum ben
ornek olarak gonderdıgım dosyaya ekleyıp buraya post edersenız ordan alıp ıncelerım daha guzel olur.

 

[Murat OSMA]

Net Evn satırından sonra

Range("E1").Delete Shift:=xlUp

yazabilirsiniz...

Dosyayı ekliyorum...

 

[merakli_72]

peki bu (2,1) anlamı nedir
ben birşeye benzetemedim

 

[Murat OSMA]

O da ne olduğunu bilmiyor.