• DİKKAT

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

Satır sil,

Katılım
10 Ekim 2010
Mesajlar
1,469
Excel Vers. ve Dili
2010 Türkçe
Merhaba,
Arkadaşlar örnek dosyaya bir buton ekleyerek B3:B sütunda bulunan verilerden, MH, MB, MD ile başlayanlar hariç diğer veriler içeren hücrelerin satırla beraber silinmesini istiyorum. Çok hızlı bir yöntem olması gerekmektedir. Yardımcı olabilir misiniz?
İyi akşamlar dilerim.
 
Merhaba,
Arkadaşlar örnek dosyaya bir buton ekleyerek B3:B sütunda bulunan verilerden, MH, MB, MD ile başlayanlar hariç diğer veriler içeren hücrelerin satırla beraber silinmesini istiyorum. Çok hızlı bir yöntem olması gerekmektedir. Yardımcı olabilir misiniz?
İyi akşamlar dilerim.

Merhaba
Boş bir module kopyalayın ve deneyin.
Kod:
Option Explicit
Sub harfli_sil()
'Konu       :   M ile Başlayanların Dışındakileri Sil
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim a As Long
Application.ScreenUpdating = False
For a = Cells(Rows.Count, "B").End(xlUp).Row To 3 Step -1
If Cells(a, "B") Like "M*" Then
Else
Rows(a).Delete
End If: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
Bu koda özel orjinal kod yazdım :)
 
Son düzenleme:
Merhaba, yaptığı işlem gösteriyor, bana daha hızlı bir yöntem lazım.Böyle bir iki saniye içinde yapabilecek bir hız lazım. 1 dk kadar süruyor :(
Alternatif kod yokmu arkadaşlar ?
 
Merhaba,
Denedim ama çok uzun zamanda işlemi yapıyor, bana bi kaç saniye içerisinde yapacak bi kod lazım. Bu sayfada bu işlem gibi yaklaşık 10 işlem yapacağımdan çok uzun zaman alacak. ben bu süreyi minumum seviyeye indirmek istiyorum. her işlem 1 dk sürmüş olsa eyvah.

Değerli hocalarım, arkadaşlarım sizlerden de bu konua bilgi bekliyorum.
İyi akşamlar dilerim.
 
Merhaba,
Bayadır arama yaptım bu konuya benzer birçok yöntem sunulmuş, en uygun olanları seçtim sonuca gidemedim istediğim gibi. Örnek dosyaya göre hızlı bir yöntem nasıl bulabiliriz. Yardımcı olabilir misiniz? Teşekkür ederim. İyi akşamlar dilerim.
 
Merhaba,

En hızlı yöntem filtre ile silme işlemi yapmaktır. Verilerinizin yedeğini alıp aşağıdaki kodu denermisiniz.

Kod:
Sub HIZLI_KOŞULLU_SATIR_SİL()
    Application.ScreenUpdating = False
    
    If ActiveSheet.AutoFilterMode Then ActiveSheet.ShowAllData
    
    With Range("IV3:IV" & Cells(Rows.Count, 2).End(3).Row)
        .Formula = "=IF(OR(LEFT(B3,2)=""MB"",LEFT(B3,2)=""MD"",LEFT(B3,2)=""MH""),""-"",""SİL"")"
        .Value = .Value
    End With
    
    Range("IV2") = "FİLTRE"
    Range("IV2").AutoFilter Field:=1, Criteria1:="SİL"
    
    If Cells(Rows.Count, 2).End(3).Row > 2 Then
        Range(Range("A3"), Cells(Rows.Count, 2).End(3)).EntireRow.Delete
    End If
    
    Range("IV:IV").Delete
    Range("A1").Select
    Application.ScreenUpdating = True
    
    MsgBox "Silme işlemi tamamlanmıştır.", vbInformation
End Sub
 
Korhan Bey,
Ne kadar teşekkür etsem azdır, istediğimden daha fazla hızlı çalışıyor. Abi çok teşekkür ederim. Allah’ım razı olsun senden. Düşüncelerine fikirlerine, bilgine hayranım. İyi çalışmalar dilerim.
 
Günaydın Korhan Bey, Hayırlı sabahlar.
Bu yazdığınız makro çok güzel istediğim gibi fakat sayfada bundan başka da satır silme işlemi var. Bu filtre yaparak siliyor sanırsam. Bundan sonrakilerde hata alıyorum. Bu kodu normal filtresiz silme olarak uyarlaya bilimiyiz.
İyi günler dilerim.
 
Son düzenleme:
Merhaba,

En hızlı yöntem budur. Bunun dışında döngü ile satır silinebilir. Bu yöntemde 2. mesajda önerildi. İki yöntem arasındaki süreyi siz kıyaslayın. Bence filtre yöntemini kullanın ve hataya sebep olan durumu kontrol altına almaya çalışın.
 
Merhaba,

Birde aşağıdaki kodu denermisiniz.

Kod:
Option Explicit
Option Base 1
 
Sub Koşullu_Satır_Sil()
    Dim Veri(), X, Dizi(), Alan As Range, Satir As Long
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
         
    Satir = Cells(Rows.Count, 2).End(3).Row
    If Satir < 3 Then Exit Sub
    
    If Satir = 3 Then
        If UCase(Left(Cells(Satir, "B"), 2)) <> "MB" And _
        UCase(Left(Cells(Satir, "B"), 2)) <> "MD" And _
        UCase(Left(Cells(Satir, "B"), 2)) <> "MH" Then
            Rows(Satir).Delete
        End If
    Else
    
        Veri = Range("B3:B" & Satir).Value
        
        ReDim Dizi(UBound(Veri))
        
        For X = 1 To UBound(Veri)
            Dizi(X) = Veri(X, 1) & "#B" & X + 2
        Next
        
        For X = 3 To UBound(Dizi) + 2
            If UCase(Left(Dizi(X - 2), 2)) <> "MB" And _
            UCase(Left(Dizi(X - 2), 2)) <> "MD" And _
            UCase(Left(Dizi(X - 2), 2)) <> "MH" Then
                If Alan Is Nothing Then
                    Set Alan = Range(Split(Dizi(X - 2), "#")(1))
                Else
                    Set Alan = Application.Union(Alan, Range(Split(Dizi(X - 2), "#")(1)))
                End If
            End If
        Next
        
        If Not Alan Is Nothing Then
            Alan.EntireRow.Delete
        End If
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Günaydın Korhan Bey,
Sonraki yazdığınız kod daha iyi. Tam istediğim gibi. Fakat bu kod ekleyeceğim sayfada çalışmıyor. Sıradan bir excel de denediğim zaman kusursuz çalışıyor. Verdiği hatayı resim olarak ekledim. Neden kaynaklanıyor olabilir.
 

Ekli dosyalar

  • hata.jpg
    hata.jpg
    69.8 KB · Görüntüleme: 11
Merhaba,

Bu makronun adını değiştirip deneyin. Diğer satır silme ile ilgili sorunuzada bu tarz bir kod önermiştim. İsimleri aynı olduğu için sorun çıkmış olabilir.

Eğer sorun başka ise dosyanızı foruma ekleyin kontrol edelim.
 
Merhaba
Boş bir module kopyalayın ve deneyin.
Kod:
Option Explicit
Sub harfli_sil()
'Konu       :   M ile Başlayanların Dışındakileri Sil
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim a As Long
Application.ScreenUpdating = False
For a = Cells(Rows.Count, "B").End(xlUp).Row To 3 Step -1
If Cells(a, "B") Like "M*" Then
Else
Rows(a).Delete
End If: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
Bu koda özel orjinal kod yazdım :)

sayın asi kral size acizane bir eleştiri yapmak istiyorum haddim olmayarak, sizde burdaki üstadlar gibi excel konusunda iyi seviyedesiniz bu anlaşılıyor zaten ancak her kod yazdığınızda neden gereksiz mail, skype gibi bilgilerinizi giriyorsunuz buna gerek yokki, zaten bir çok kişi o bölümleri siliyor yada değiştiriyordur.
 
Merhaba Korhan Bey,
Kodların tümünü sildim sadece bu kodu ekledim yine aynı hatayı alıyorum. Sayfayı buraya eklemeyi bende çok isterim. İlk sorun Şirket adına önemli bir dosya. İkincisi ise şirketin sistemiyle bağlantılı çalışıyor. Eklediğim de sıradan bir excel oluyor. Zaten sıradan excelde çalışmasında sıkıntı yok. Uzak bağlantı yapabilir miyiz Teamwiewer proğramı ile.
 
sayın asi kral size acizane bir eleştiri yapmak istiyorum haddim olmayarak, sizde burdaki üstadlar gibi excel konusunda iyi seviyedesiniz bu anlaşılıyor zaten ancak her kod yazdığınızda neden gereksiz mail, skype gibi bilgilerinizi giriyorsunuz buna gerek yokki, zaten bir çok kişi o bölümleri siliyor yada değiştiriyordur.

Eleştiriniz için teşekkür ederim. Canım öyle istiyor bende öyle yazıyorum. Silmek isteyen siler silmek istemeyen silmez burasına da karışamam kodu yazdıktan sonra siteye ekliyorsam kod artık benim değil ihtiyacı olanlarındır. Ben sadece imza mı atarım gerisi kullanan kişiye kalmış. İster siler kullanır isterse direk yapıştırır kullanır isterse değiştirir kullanır buna karışamam. Sizin de işinize neresi yarıyorsa orayı kullanın ve bunları kafanıza boşuna takmayın. Herkesin zevki birinci mevki. Kendinize iyi bakın.
 
Merhaba Korhan Bey,
Örnek çalışmada butonu tıkladığımda 400 hatası alıyorum. Neden olabilir sayfada bundan başka kod da yok. Yine mi bir yerlerde yanlış yapıyorum.
Teşekkür ederim. İyi akşamlar dilerim.
 
Son düzenleme:
Geri
Üst