Şarta uymayan satırları sil

[ridvan2111]

Merhaba,
Örnek dosyada AG sutununda tarihler var, userform açarak text kutusundaki tarih dışındaki tarihleri sildiriyorum fakat kod çok yavaş çalışıyor 2 dk. yakın sürüyor. Daha hızlı olabilirmi.

Ayrıca bu kod başlık satırınıda siliyor başlık satırı kalmalı.

Private Sub CommandButton1_Click()
Dim sat As Integer
Sheets("Dis_Verial").Select
    For sat = Cells(65536, "AG").End(xlUp).Row To 1 Step -1
        If Not Cells(sat, "AG") = TextBox1.Text Then 'Not öğesini kaldırırsanız tersini yapar
            Cells(sat, "AG").EntireRow.Delete Shift:=xlUp
        End If
    Next

MsgBox "Diger Tarihler Silindi.", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[muygun]

Merhaba;
Kodlardaki;
For sat = Cells(65536, "AG").End(xlUp).Row To 1 Step -1

To 1 bölümünü To 2 yaparsanız başlıklar silinmez.
Ayrıca userform devre dışı olursa silme işlemi en azından 2 dk. sürmez.
inceleyin.
İyi çalışmalar.

 

[ridvan2111]

Teşekkürler muygun.

Yinede uzun sürüyor

Peki Filtre kullanılarak uf deki textbox1 e uyan tarihi "Dis_Verial" sayfasında filtrelesin filtre olan veriyi başka bir sayfaya "sayfa1" aktarsın sonra filtreyi kaldırarak "Dis_Verial"A2:AL aralıgını silsin "sayfa1" deki veriyi kopyalayarak "Dis_Verial" sayfasına yapıştırsın.

bu şekilde olabilirmi ?

 

[muygun]

Merhaba;
Bu çözüm işinizi görecekse eki deneyin.
İyi çalışmalar.

 

[ridvan2111]

Teşekkürler. Verdiğiniz kod çalışıyor fakat işime yaramadı.

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Sheets("Dis_Verial").Select
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False

sat = Cells(Rows.Count, "AG").End(xlUp).Row
ActiveSheet.Range("$A$1:$AL$65000").AutoFilter Field:=33, Operator:=xlFilterValues, Criteria2:=Array[COLOR="Red"](1, "09/29/2012", 2, "10/01/2012")[/COLOR]

On Error GoTo son
Application.DisplayAlerts = False
Range("AG2:AG" & sat).SpecialCells(xlCellTypeVisible).Delete


Application.DisplayAlerts = True
Range("A1").AutoFilter
Sheets("Dis_Verial").Select

MsgBox "Diğer Tarihler silindi.", vbOKOnly + vbInformation, "SATIRLAR SİLİNDİ"
Exit Sub
son:
Range("A1").AutoFilter
Range("A2").Select
Application.ScreenUpdating = True
'MsgBox "0 bulunamadı.", vbCritical, "U Y A R I"
End Sub

bu filtreleme yöntemi ile 30.09.2012 tarihine uyanlar siliniyor.

bu kriteri uf deki textbox1 den alsa ve textbo1 haricindekileri silse tam istediğim gibi olacak

 

[Korhan Ayhan]

Merhaba,

Verilerinizin yedeğini alıp aşağıdaki kodları deneyiniz.

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, Zaman As Double, Veri As Variant
    Dim Satir As Long, X As Long, Say As Long
        
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual
        
    Zaman = Timer
    
    Set S1 = Sheets("Dis_Verial")
    
    Satir = S1.Cells(Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:AL" & Satir).Value
    
    ReDim Dizi(1 To 38, 1 To 1)
        
    For X = 1 To UBound(Veri, 1)
        If CDate(TextBox1) = Veri(X, 33) Then
            Say = Say + 1
            ReDim Preserve Dizi(1 To 38, 1 To Say)
            For Y = 1 To 38
                If Y = 35 Then
                    Dizi(Y, Say) = "'" & Veri(X, Y)
                Else
                    Dizi(Y, Say) = Veri(X, Y)
                End If
            Next
        End If
    Next
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    If Say > 0 Then
        Range("A2:AL" & Rows.Count).ClearContents
        ReDim Preserve Dizi(1 To 38, 1 To Say)
        Range("A2").Resize(UBound(Dizi, 2), 38) = Application.Transpose(Dizi)
        Range("A:AL").EntireColumn.AutoFit
        MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
               "İşlem süresi ; " & Format((Timer - Zaman) / 60 / 60 / 24, "hh:mm:ss.ms"), vbInformation
    Else
        MsgBox "Uygun kayıt bulunamadı!", vbCritical
    End If
End Sub
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    TextBox1 = Format(TextBox1, "dd.mm.yyyy")
End Sub
 
Private Sub UserForm_Initialize()
    TextBox1.Text = Date
    TextBox1.Value = Format(TextBox1.Value, "dd.mm.yyyy")
End Sub

 

[ridvan2111]

Sayın. Korhan Bey 1,20 sn. Mükemmel Teşekkürler.

Sayın. muygun Sizin kodunuzda hızlı olmasına rağmen kullanamadım. Alakanız için çok teşekkürler.