Karışık Telefon Listelerinizi Düzenlemek için Makro ve Mantığı

[blueapple]

Merhabalar,

Bir kaç ayrı döküman halinde telefon listem vardı,
Zamanla her seferinde farklı faklı kişiler giriş yapmış ve herkes faklı formatlarda girmiş.Kimisi 00 90212, kimisi +90 212 kimisi (212)... hatta bazıları tek telefon girilmesi gerekirken aynı hücreye üç faklı telefon girmiş ve bunu gene çeşitlendirerek (xxx) xxx xx xx/xx yada (xxx) xxx xx xx - (xxx) xxx xx xx xx seklinde girişler yapmayı başarmışlar

İhtiyacım olan data ise tek telefon ve (XXX) XXX XX XX şeklindeydi,
makro yazdım ihtiyacı olan dostlar istedikleri sekilde degistirip kullansınlar.

Sub Temizle_Duzenle()
'Yazan BlueApple - www.excel.web.tr
Cells.Select '---> Tüm hücreleri sec
Selection.NumberFormat = "@" '--->Tüm hücrelerin formatını "Text" olarak degistir
Range("A1").Select ' --->A1 hücresini sec

x = "C" '---> x adında degisken tanimladim ki sutun degistirmek istedigimde sadece burayi degistirmem yetsin

For i = 2 To 100 ' ---> 2 ile 100 uncu satirlar arasinda islem yapmak istedigim icin döngü araligini bu sekilde belirledim

If Not Cells(i, x) = "" Then ' Bir kosul yazıyorum anlamı eger hücre bos degilse yani dolu ise al satirdan devam et ama bos ise ileride bununla ilgili baska islem yapacagim

' ####Temizlik ve düzenleme islemleri buradan basliyor

Cells(i, x) = Trim(Cells(i, x)) ' Solda bosluk varsa siliyor
Cells(i, x) = Replace(Cells(i, x), " ", "") ' ---->Bosluk varsa siliyor
Cells(i, x) = Replace(Cells(i, x), "+90", "") ' ---->"+90" ları siliyor
Cells(i, x) = Replace(Cells(i, x), "+", "") ' ---->"+" ları siliyor
Cells(i, x) = Replace(Cells(i, x), "(", "") ' ---->"(" ları siliyor
Cells(i, x) = Replace(Cells(i, x), ")", "") ' ---->")" ları siliyor
Cells(i, x) = Replace(Cells(i, x), "-", "") ' ---->"-" ları siliyor
Cells(i, x) = Replace(Cells(i, x), "[", "") ' ---->"[" ları siliyor
Cells(i, x) = Replace(Cells(i, x), "]", "") '---->"]" ları siliyor
Cells(i, x) = Replace(Cells(i, x), ".", "") '---->"." ları siliyor

If Left(Cells(i, x), 1) = "0" Then '----> Eger bu hücrenin en solundaki metin "0" ise
Cells(i, x) = Mid(Cells(i, x), 2, 999) '----> Bu hücrenin 2. karakterinden baslayarak sonraki 999 karakteri aynı hücreye yaz
Else ' ---> Degilse
End If '---> Eger isleminin sonu yani birsey yapmadan islemi bitir

' Asagida aynı islemli tekralıyorum cunki telefon numaralarının basinda genelde 00 olabiliyor...

If Left(Cells(i, x), 1) = "0" Then '----> Eger bu hücrenin en solundaki metin "0" ise
Cells(i, x) = Mid(Cells(i, x), 2, 999) '----> Bu hücrenin 2. karakterinden baslayarak sonraki 999 karakteri aynı hücreye yaz
Else ' ---> Degilse
End If '---> Eger isleminin sonu yani birsey yapmadan islemi bitir

' Yukarida salt olarak numaralar kaldı ama biliyorum ki ilk uc hanesi alan kodu
' sonraki üc + iki + iki rakam da telefon olmalı
' yani istedigim yazım bicimi (xxx) xxx xx xx  seklinde olamlı fakat son bir görsel kontrol icin
' devamında numara var ise onuda görebilmem adına asagidaki formatta yazdırmak istiyorum
' (xxx) xxx xx xx >yyyyyy
' buradaki y ler fazla kalan numaralar kontrol saglandiktan sonra asagidaki "Tamamla "Makrosundan bu "y" leri
' sildirecegim

Cells(i, x) = "(" + Mid(Cells(i, x), 1, 3) + ") " + Mid(Cells(i, x), 4, 3) + " " + Mid(Cells(i, x), 7, 2) + " " + Mid(Cells(i, x), 9, 2) + ">" + Mid(Cells(i, x), 11, 20)

' ####Temizlik ve düzenleme islemleri burada bitiyor

Else ' ilk yazdigim "If" eger ifadesinin yaninda ki kosul gerceklesmezse yani hücre bos ise
Cells(i, x).Interior.ColorIndex = 3 '---> Hücreyi kırmızıya boya
End If '---> Eger isleminin sonu yani birsey yapmadan islemi bitir

Next i '---> Döngüyü bir sonraki hücre için yeniden baslat
End Sub

Sub Tamamla()
x = "C"

For i = 2 To 100
' Eger sizin istediğiniz formatta basina "+90" koymaniz gerekiyorsa asagidaki satirin basini Cells(i, x) = "+90 "+ Left.... seklinde degistirebilirsiniz.

Cells(i, x) = Left(Cells(i, x), 15) ' hücre icinde ki soldan ilk 15 kelimeyi gene aynı hücreye yazdirip geri kalanı sildiriyorum

Next i
End Sub

 

[Korhan Ayhan]

Merhaba,

Yeni üye olmuş bir üyemiz olarak hazırladığınız makronuzu bizimle paylaştığınız için teşekkür ederim. Umarım üyelerimizin işiney yarar. Küçük bir hatırlatmada bulunmak istiyorum. Kodlarınızı foruma eklerken

 tagını kullanırsanız anlaşılması daha kolay olacaktır. Bu şekilde düz yazıyı okumak ve anlamak zor oluyor. Bahsedilen taga mesaj penceresindeki "#" işaretini kullanarak ulaşabilirsiniz.
 
Tekrar elinize sağlık. Başka başlıklar içinde makrolu ya da fonksiyonlu çözümler için katılımlarınızı bekliyoruz.

 

[Necdet]

Merhaba,

Bende kodlar için teşekkür ederim. Ancak sadece kodlar olayı anlamada havada kalıyor. Küçük bir örnek dosya olsaydı kodların çalışmasını görmek açısından çok arkadaşımızın işine yarardı diye düşünüyorum.

 

[blueapple]

Merhaba,

Yeni üye olmuş bir üyemiz olarak hazırladığınız makronuzu bizimle paylaştığınız için teşekkür ederim. Umarım üyelerimizin işiney yarar. Küçük bir hatırlatmada bulunmak istiyorum. Kodlarınızı foruma eklerken

 tagını kullanırsanız anlaşılması daha kolay olacaktır. Bu şekilde düz yazıyı okumak ve anlamak zor oluyor. Bahsedilen taga mesaj penceresindeki "#" işaretini kullanarak ulaşabilirsiniz.
 
Tekrar elinize sağlık. Başka başlıklar içinde makrolu ya da fonksiyonlu çözümler için katılımlarınızı bekliyoruz.[/QUOTE]

Mesajınız için teşekkür ederim, gerekli düzenlemeyi yukarıda yaptım.