• DİKKAT

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

Mail Listesi Oluşturma.

Katılım
20 Nisan 2008
Mesajlar
185
Excel Vers. ve Dili
Office 2021 TR
Merhaba arkadaşlar ;

Ekteki dosyada bir mail adresi oluşturmak istiyorum.

A1 hucresine kopyaladığım verileri ; den sonra ayırarak B1 hucresıne alt alta listelemesını istiyorum.

2 - daha sonra C1 hucresine yapıstırdıgım liseyi B1 hucresi ile karsılastırıp çift olanları silerek D1 hucresine kayıt etmek istiyorum


Yardımlarınız için şimdiden teşekkür ederim.
 

Ekli dosyalar

1. sorunuz için kod:
kod aynı zamanda çift olanları teke düşürerekde sıralıyor.


Kod:
Sub ayır()
For i = 1 To [a65000].End(3).Row
aranan = Cells(i, 1).Value
adres = Split(Trim(aranan), ";")
For j = 0 To UBound(adres)
sat = sat + 1
Cells(sat, 2) = Trim(Replace(adres(j), ";", ""))
Next
Next
Columns(2).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("c1"), Unique:=True
Columns(3).Sort Key1:=Range("c1"), Order1:=xlAscending, Header:=xlGuess
MsgBox "İşlem tamam."
End Sub
 
1. sorunuz için kod:
kod aynı zamanda çivt olanları tek düşürerekde sırakıyor.


Kod:
Sub ayır()
For i = 1 To [a65000].End(3).Row
aranan = Cells(i, 1).Value
adres = Split(Trim(aranan), ";")
For j = 0 To UBound(adres)
sat = sat + 1
Cells(sat, 2) = Trim(Replace(adres(j), ";", ""))
Next
Next
Columns(2).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("c1"), Unique:=True
Columns(3).Sort Key1:=Range("c1"), Order1:=xlAscending, Header:=xlGuess
MsgBox "İşlem tamam."
End Sub


Halit Kardeş teşekkür ediyorum. Evet Sorunum bir kısmını halletmişiniz saolun.

Şimdi c ve d sütunlarını karsılastırıp E Sütununa listelemesini istiyorum..

Sizin verdiğiniz kodu uygalmış olduğum dosya ektedir. İçinde örnek veride vardır.

Teşekkür ederim...
 

Ekli dosyalar

Halit Kardeş teşekkür ediyorum. Evet Sorunum bir kısmını halletmişiniz saolun.

Şimdi c ve d sütunlarını karsılastırıp E Sütununa listelemesini istiyorum..

Sizin verdiğiniz kodu uygalmış olduğum dosya ektedir. İçinde örnek veride vardır.

Teşekkür ederim...

Karşılaştırmaya gerek varmı D sutünundaki aynı olanların birden fazlası için silme kodu:

Kod:
Sub ayniolanlarisil()
Dim say(5000)
For r = 1 To Cells(Rows.Count, "d").End(3).Row
aranan = Cells(r, 4).Value
If WorksheetFunction.CountIf(Range("D1:D" & r), aranan) > 1 Then
For i = r To Cells(Rows.Count, "d").End(3).Row
bulunan = Cells(i, 4).Value
If aranan = bulunan Then
sat = sat + 1
say(sat) = i
End If
Next
End If
Next
For j = sat To 1 Step -1
Cells(say(j), 4).Delete Shift:=xlUp
Next j
MsgBox "işlem tamam."
End Sub
 
Karşılaştırmaya gerek varmı D sutünundaki aynı olanların birden fazlası için silme kodu:

Kod:
Sub ayniolanlarisil()
Dim say(5000)
For r = 1 To Cells(Rows.Count, "d").End(3).Row
aranan = Cells(r, 4).Value
If WorksheetFunction.CountIf(Range("D1:D" & r), aranan) > 1 Then
For i = r To Cells(Rows.Count, "d").End(3).Row
bulunan = Cells(i, 4).Value
If aranan = bulunan Then
sat = sat + 1
say(sat) = i
End If
Next
End If
Next
For j = sat To 1 Step -1
Cells(say(j), 4).Delete Shift:=xlUp
Next j
MsgBox "işlem tamam."
End Sub

Halit Kardeş suan dosyayı kontrol edemiyorum ama ;

Karsılastırma istememın sebebı su surekli güncel tutmak için. Kontrol eder etmez hemen sizi bilgilendireceğim. Acaba Sizin yazdıgınız bu ıkı koduda tek kod haline getirebilirmiyiz..

Yani her iki kodu da sayfa 1 de kod bolumune mı yapıstıracam .

Teşekkürler Saygılar..
 
Halit kardeş. Kodu denedim Hiç bir değişiklik göremedim..

Yada ben anlatamadım kardeş.

ilk verdiğiniz kod çok güzel ayırma işlemi yapıyor.

diyelimki ilk veriyi ayırdık B sutununa

ben bu b sutunundan o veriyi c sutununa kopyalıyorum

ıkıncı verıyı A sutununa gırtdık tekrar ayırdık

yine B sutununa işledi

Bu durumda ben B sutunundakı veriyi Bu Kez D sütununa kopyalıyorum.

İşte Tam Burda C ve D sütunlarını karsılastıracak ve Tek liste olarak E sütununa atacak...

Bu İşlemi defalarca uyguladıgımı varsayarsak ki yapacam zaten. İkinci Kod Çalışmıyor istediğim gibi..

Umarım Anlatabilmişimdir...

Teşekkür ederim...
 

Ekli dosyalar

Halit kardeş. Kodu denedim Hiç bir değişiklik göremedim..

Yada ben anlatamadım kardeş.

ilk verdiğiniz kod çok güzel ayırma işlemi yapıyor.

diyelimki ilk veriyi ayırdık B sutununa

ben bu b sutunundan o veriyi c sutununa kopyalıyorum

ıkıncı verıyı A sutununa gırtdık tekrar ayırdık

yine B sutununa işledi

Bu durumda ben B sutunundakı veriyi Bu Kez D sütununa kopyalıyorum.

İşte Tam Burda C ve D sütunlarını karsılastıracak ve Tek liste olarak E sütununa atacak...

Bu İşlemi defalarca uyguladıgımı varsayarsak ki yapacam zaten. İkinci Kod Çalışmıyor istediğim gibi..

Umarım Anlatabilmişimdir...

Teşekkür ederim...

Kod B sutünuna mail adreslerini ayrıştırarak aktarıyor.
C sutünunda B sutündaki mail adreslerini teke indiriyor
D sutünundaki mail adreslerinide E sutünunda teke indiriyor.
 

Ekli dosyalar

İyi çalışmalar

Halit Bey Merhaba sizi yine mesgul edecem ama hakkınızı helal edin..

Dosyanızı az once inceledim..

ekteki dosyada A3 ve A4 hücrelerinde veriler var

A1 hücresi formulun çalıştığı hücre..


Her iki veriyi tek tek A1 hücresine kopyalayıp AYIR butonuna bastığımda

E1 hücresinde tek liste olması gerekirken çok az mail adresi görünüyor..

Yani b hücresinde 100 mail adresi görünürken E1 sütununda çok çok az görünüyor.. Ki o kadar çifgt mail yok bakarsanız memnun olurum...

Benim hatam nerde

Teşekkür ederim.
 

Ekli dosyalar

Halit Bey Merhaba sizi yine mesgul edecem ama hakkınızı helal edin..

Dosyanızı az once inceledim..

ekteki dosyada A3 ve A4 hücrelerinde veriler var

A1 hücresi formulun çalıştığı hücre..


Her iki veriyi tek tek A1 hücresine kopyalayıp AYIR butonuna bastığımda

E1 hücresinde tek liste olması gerekirken çok az mail adresi görünüyor..

Yani b hücresinde 100 mail adresi görünürken E1 sütununda çok çok az görünüyor.. Ki o kadar çifgt mail yok bakarsanız memnun olurum...

Benim hatam nerde

Teşekkür ederim.

B sutünunda 178 mail adresi var
C sutünunda 100 mail adresi var

Burada eksiklik yok

Excelin kendi menülerinden B sutünunu bloko ederek A-Z ye sıralama yapıp inceleyin
 
Geri
Üst