İstenmeyen numaraların ana listeden silinmesi

[erhan1232]

1. kolonda ana listede telefonu numaraları var 2. kolanda ise istenmeyen telefon numaraları var. 3. kolana ana listeden istenmeyen numaraların çıkarılıp temiz bir liste oluşturmak istiyorum ekte bir örnek vardır teşekkürler..

 

[Ömer]

Merhaba,

Eki inceleyiniz..

.

 

[erhan1232]

Teşekkürler fakat tabloda sadece 100 numaraya kadar yapabiliyorum bunu 30000e nasıl çıkarabilim? Biraz ugraştım ama yapamadım yardımcı oluriseniz sevinirim..

 

[Ömer]

Formül aralıklarındaki 100 olan bölgeleri 30000 yapmanız gerekir..

D1 hücresindeki 100 olan bölgeyi 30000 yapınız.

C2 hücresindeki 100 olan tüm bölgeleri 30000 yaptıktan sonra ctrl sihift entera basarak formülü dizi formülüne çeviriniz daha sonra C2 deki formülü alt hücrelere kopyalayınız..

Yalnız tablonuz 30000 satırda oluşuyor ise fonksiyonlarla çalışmak sıkıntı yaratabilir. Bunun için makro kullanmak daha doğru olacaktır..

.

 

[erhan1232]

Teşekkürler. Makro ile nasıl yapabilirim?

 

[Necdet]

Merhaba,

Makrolu çözüm isterseniz aşağıdaki kodları deneyiniz.

Option Explicit
Sub ListedeTemizlik()
Dim s1 As Worksheet
Dim Bul As Range
Dim i As Long, SatirNo As Long
Set s1 = Sheets("Sheet1")
SatirNo = 1
Application.ScreenUpdating = False
s1.Range("C2:C65536").ClearContents
For i = 2 To s1.[A65536].End(3).Row
    Set Bul = s1.Range("B:B").Find(s1.Cells(i, "A"), LookIn:=xlValues)
    If Bul Is Nothing Then
        SatirNo = SatirNo + 1
        s1.Cells(SatirNo, "C") = Cells(i, "A")
    End If
Next i
Application.ScreenUpdating = True
MsgBox "Yeni Liste Oluşturulmuştur", vbOKOnly, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
End Sub

 

[erhan1232]

Çok Teşekkürler.

 

[erhan1232]

isimleride ekleyebilirmiyiz?

Ekteki gibi isimleride ekleme şansımız varmı acaba?

 

[Ömer]

Aşağıdaki kodları kullanın.

Option Explicit
Sub ListedeTemizlik()
Dim s1 As Worksheet
Dim Bul As Range
Dim i As Long, SatirNo As Long
Set s1 = Sheets("Sheet1")
SatirNo = 1
Application.ScreenUpdating = False
s1.Range("E2:F65536").ClearContents
For i = 2 To s1.[A65536].End(3).Row
    Set Bul = s1.Range("C:C").Find(s1.Cells(i, "A"), LookIn:=xlValues)
    If Bul Is Nothing Then
        SatirNo = SatirNo + 1
        s1.Cells(SatirNo, "E") = Cells(i, "A")
        s1.Cells(SatirNo, "F") = Cells(i, "B")
    End If
Next i
Application.ScreenUpdating = True
MsgBox "Yeni Liste Oluşturulmuştur", vbOKOnly, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
End Sub

.

 

[erhan1232]

Teşekkürler Kodları tam olarak nereye kopyalamam gerekiyor?

 

[Ömer]

Necdet Bey'in dosyasını incelemediniz mi? Detaylı bilgi için aşağıdaki linki inceleyiniz..

Modül Ekleme (Resimli Anlatım)


.

 

[erhan1232]

Teşekkürler Kodları gösterildigi gibi yaptım fakat sadece Kodlar yazıldıgı yerden ''run'' yaptıgım zaman çalışıyor. ekrana kodlara çalıştırmak için bir butan getirebilirmiyim acaba?

 

[Ömer]

Forumda arama yaparsanız istediğiniz birçok bilgiye ulaşabilirsiniz..

Sayfada Buton-Düğme Oluşturmak ve Makro Atamak (Resimli Anlatım)

.

 

[erhan1232]

Çok Teşekkürler..