Koşullu Veri Silmek

[baydeniro]

Merhaba Arkdaşlar,
Bir Veri aralığında, diyelim ki A1:A10 arasında bulunan bazı hücrelerde "A" harfi bulunmaktadır. İçinde "A" harfi barındıran hücrelerin silinmesi mümkün mü ?

 

[Korhan Ayhan]

Büyük-küçük harf durumu önemli mi?

 

[baydeniro]

Büyük-küçük harf durumu önemli mi?

Hayır üstad, önemli değil

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub A_Harfi_Iceren_Hucreleri_Sil()
    Dim Veri As Variant, Liste As Variant, Say As Long
    Dim Son As Long, X As Long, Zaman As Double
    
    If WorksheetFunction.CountA(Range("A:A")) = 0 Then
        MsgBox "Sorgulanacak veri bulunamadı!", vbExclamation
        Exit Sub
    End If
    
    Zaman = Timer
    
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A1:A" & Son).Value2
    
    ReDim Liste(1 To Rows.Count, 1 To 1)
        
    If Son = 1 Then
        If Veri <> "" Then
            If InStr(1, Veri, "A", vbTextCompare) = 0 Then
                Say = Say + 1
                Liste(Say, 1) = Veri
            End If
        End If
    Else
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If Veri(X, 1) <> "" Then
                If InStr(1, Veri(X, 1), "A", vbTextCompare) = 0 Then
                    Say = Say + 1
                    Liste(Say, 1) = Veri(X, 1)
                End If
            End If
        Next
    End If
        
    Range("A:A").ClearContents
    If Say > 0 Then Range("A1").Resize(Say, 1) = Liste
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[baydeniro]

Deneyiniz.

Option Explicit

Sub A_Harfi_Iceren_Hucreleri_Sil()
    Dim Veri As Variant, Liste As Variant, Say As Long
    Dim Son As Long, X As Long, Zaman As Double
   
    If WorksheetFunction.CountA(Range("A:A")) = 0 Then
        MsgBox "Sorgulanacak veri bulunamadı!", vbExclamation
        Exit Sub
    End If
   
    Zaman = Timer
   
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A1:A" & Son).Value2
   
    ReDim Liste(1 To Rows.Count, 1 To 1)
       
    If Son = 1 Then
        If Veri <> "" Then
            If InStr(1, Veri, "A", vbTextCompare) = 0 Then
                Say = Say + 1
                Liste(Say, 1) = Veri
            End If
        End If
    Else
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If Veri(X, 1) <> "" Then
                If InStr(1, Veri(X, 1), "A", vbTextCompare) = 0 Then
                    Say = Say + 1
                    Liste(Say, 1) = Veri(X, 1)
                End If
            End If
        Next
    End If
       
    Range("A:A").ClearContents
    If Say > 0 Then Range("A1").Resize(Say, 1) = Liste
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

Üstad elinize aklınıza sağlık. Çok harika bir kod, mükemmel çalıştı. Sağlıcakla kalın.