Kayıtlar Sınıflandırmak ve Tekrar Eden Kayıtları Silmek - Acil

[tefon]

Arkadaşlar merhaba..

Öncelikle zaman ayırıp konuyu okuyan herkese teşekkür ederim. Elimde bir excel dosyası bulunmakta. Dosyada müşterilerimize ait telefon numaraları var. Örnek vermek gerekirse;

0 (505) *** 14 **
0 (532) *** 80 **
0 (542) *** 28 **
0 (552) *** 81 **
0 (545) *** 20 **
0 (539) *** 60 **

gibi devam etmekte. Bu numaraları Vodafone, Turkcell, Avea şeklinde ayırmak istiyoruz.

0 (53*) ile başlayanları Turkcell
0 (54*) ile başlayanları Vodafone
0 (55*) ile başlayanları Avea

şeklinde. Ve sonrasında tekrar eden numaralar var ise bulunup silinmesini istiyoruz. Bununla ilgili örnek bir Makro verebilecek olan var mı?

şimdiden çok teşekkür ederim.

iyi çalışmalar

 

[Emir Hüseyin Çoban]

. . .

Telefon numaraları belirttiğiniz biçimde ve A sütununda oldukları varsayarak. Aşağıdaki kodları deneyiniz.

Sub kod_bir()
aa = [a65536].End(3).Row

For i = 1 To aa

If Cells(i, "a") Like "0 (53" & "*" Then
Cells(i, "b") = "turkcell"
End If

If Cells(i, "a") Like "0 (54" & "*" Then
Cells(i, "b") = "vodafone"
End If

If Cells(i, "a") Like "0 (55" & "*" Or Cells(i, "a") Like "0 (50" & "*" Then
Cells(i, "b") = "avea"
End If


Next i
End Sub

. . .

 

[baydeniro]

Fevkaledenin frevkinde sayın Hüseyin Çoban. Sağlıcakla kalın, aklınıza sağlık.

 

[tefon]

çok teşekkür ederim. verdiğiniz kodda sutun b'de istediğim işlemi yaptı fakat şöyle birşey mümkün mü;

Sutun C 'ye Turkcelleri
Sutun D'ye Vodafoneları
Sutun E'ye Aveaları kaydedebilir miyiz?

+tekrar eden kayıtlar denetleyerek silinmesini nasıl sağlayabilirim?

çok teşekkür ediyorum.

 

[Emir Hüseyin Çoban]

. . .

Sub kod_bir()
Application.ScreenUpdating = False

aa = [A65536].End(3).Row

For i = 1 To aa

If Cells(i, "a") Like "0 (53" & "*" Then
Cells(i, "B") = "turkcell"
Cells(i, "C") = Cells(i, "a")

End If

If Cells(i, "a") Like "0 (54" & "*" Then
Cells(i, "B") = "vodafone"
Cells(i, "D") = Cells(i, "a")
End If

If Cells(i, "a") Like "0 (55" & "*" Or Cells(i, "a") Like "0 (50" & "*" Then
Cells(i, "B") = "avea"
Cells(i, "E") = Cells(i, "a")
End If
Next i
i = Empty
'
For x = [A65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("A1:A" & x), Cells(x, "A")) > 1 Then Rows(x).Delete
Next x

Application.ScreenUpdating = True
End Sub

. . .

 

[tefon]

Çok teşekkür ederim Hüseyin Bey.

Fakat ben numaranın kendisini direk olarak

Sutun C
Sutun D
Sutun E 'ye taşımak istiyorum.

örnek
sutun c'de ; "0 (53" ile başlayan numaralar
sutun d'de ; "0 (54" ile başlayan numaralar
sutun e'de ; "0 (55" ve "0 (50" ile başlayan numaralar olsun istiyorum.

çok teşekkürler.

 

[Emir Hüseyin Çoban]

. . .

Soru gitgide değişiyor.
#5 nolu mesajımdaki kodları değiştirdim. Deneyiniz.

. . .

 

[tefon]

Elleriniz dert görmesin Hüseyin Bey. Çok teşekkür ediyorum ilgi ve alakanız için.