Şarta uymayan satırları sil makrosunda revizyon

[ridvan2111]

Merhaba.

Sayın Korhan Ayhan Beyin Yazmış olduğu ve işimi oldukça kolaylaştıran bu makro üzerinde revizyon yapmak zorundayım.

Şöyleki, TextBox1 tarih yerine sayı biçiminde olacak ve "AG" sutunu yerine "AI" sütununda işlem yapacak ( bul ve şarta uymayanları sil )

Private Sub CommandButton40_Click()

If TextBox1.Value = "" Then
TextBox1.Value = Format(Now, "dd.mm.yyyy")
End If


 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
        Exit Sub
    End If
    End Sub

Eğer gerekirse Örnek bir çalışma hazırlar ve eklerim.

 

[ridvan2111]

Bu şekilde düzenledim ve oldu..

Private Sub CommandButton47_Click()

If TextBox1.Value = "" Then
[COLOR="red"]TextBox1 = Format(TextBox1, "#,##")[/COLOR]
End If


 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("Boya_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 [COLOR="Red"]CDbl[/COLOR](TextBox1) = Veri(X, 35) 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
        Exit Sub
    End If
   End Sub