Koşullu Satır Silmek

metin_0606 · 4 Şubat 2021

Merhaba arkadaşlar Çalışmamda V sütunundaki hücrelerde Aktif yazıyorsa o hücrenin bulunduğu satırı komple silmek istiyorum. Toplam veri sayım 8000 satırdan oluşmaktadır.

ÖmerFaruk · 4 Şubat 2021

Sub SatırSil
For i=8000 to 2 step -1
if Range("V" &i)="Aktif" then Rows(i).Delete
Next i
End sub

metin_0606 · 4 Şubat 2021

NextLevel' Alıntı:
Sub SatırSil
For i=8000 to 2 step -1
if Range("V" &i)="Aktif" then Rows(i).Delete
Next i
End sub

Sayın nextlevel makro istediğim gibi çalışıyor ancak 8000 satırlık veride 10 dk dır sonuç alamadım bu makroyu hızlandırmamız mümkün mü acaba

ÖmerFaruk · 4 Şubat 2021

Uzun sürer ama 10 dakika olmamalıydı. Arzu ediyorsanız dosyanızı paylaşın.

PLİNT · 4 Şubat 2021

Merhaba
Alternatif olarak aşağıdaki gibi denermisiniz?
"A" sütunundan itibaren boş sütun olmadığını varsayarak
s1.Range("V1:V" & x).AutoFilter Field:=22, Criteria1:="Aktif"

Kod:

Dim s1 As Worksheet, x As Long
Application.ScreenUpdating = False
Set s1 = Sheets(ActiveSheet.Name)
x = s1.Cells(Rows.Count, "V").End(3).Row
s1.AutoFilterMode = False
s1.Range("V1").AutoFilter
s1.Range("V1:V" & x).AutoFilter Field:=22, Criteria1:="Aktif"
s1.Range("V2:V" & x).SpecialCells(xlCellTypeVisible).Cells.EntireRow.Delete
s1.AutoFilterMode = False
Application.ScreenUpdating = True

metin_0606 · 5 Şubat 2021

PLİNT' Alıntı:
Merhaba
Alternatif olarak aşağıdaki gibi denermisiniz?
"A" sütunundan itibaren boş sütun olmadığını varsayarak
s1.Range("V1:V" & x).AutoFilter Field:=22, Criteria1:="Aktif"

Kod:

Dim s1 As Worksheet, x As Long Application.ScreenUpdating = False Set s1 = Sheets(ActiveSheet.Name) x = s1.Cells(Rows.Count, "V").End(3).Row s1.AutoFilterMode = False s1.Range("V1").AutoFilter s1.Range("V1:V" & x).AutoFilter Field:=22, Criteria1:="Aktif" s1.Range("V2:V" & x).SpecialCells(xlCellTypeVisible).Cells.EntireRow.Delete s1.AutoFilterMode = False Application.ScreenUpdating = True

Sayın Pilint deneyip dönüş sağlıycağım

metin_0606 · 5 Şubat 2021

NextLevel' Alıntı:
Uzun sürer ama 10 dakika olmamalıydı. Arzu ediyorsanız dosyanızı paylaşın.

Sayın nextlevel kişisel veriler olduğu için maalesef paylaşamıyorum. Sizin yazmış olduğunuz makro 22 dakikada işlemi yarıda kesti. Toplam 1743 satır silmesi gerekirken 845 satır silip işlemi bitirdi.

PLİNT · 5 Şubat 2021

PLİNT' Alıntı:
Alternatif olarak aşağıdaki gibi denermisiniz?
"A" sütunundan itibaren boş sütun olmadığını varsayarak
s1.Range("V1:V" & x).AutoFilter Field:=22, Criteria1:="Aktif"

https://www.dosyaupload.com/kuSt Örnek dosyada "Q" sütunu boş
"v" sütununuyla "a" sütunu arasında boş sütun var ise olabilir boş sütundan sonra "v" sütununa kadar sütun sayısını Field:=22 "22" yerine yazın veya
makro kaydet ile şöyle yapın,
"Aktif" kelimesini filtreleyip "V" sütununu seçin, F5 ile açılan "git" penceresinden "özel"/"yalnızca görünür hücreler" i işaretler, sağ tık ile "satır sil" i seçip, silin
makroda çıkan Field:=? kısmını düzeltirsiniz

Seyit Tiken · 5 Şubat 2021

Bir de bu şekilde bir deneyiniz.

Kod:

For Each t In Range("A1:A8000").Cells
If t.Value = "Aktif" Then
t.Rows = ""
End If
Next t

metin_0606 · 5 Şubat 2021

PLİNT' Alıntı:
Merhaba
Alternatif olarak aşağıdaki gibi denermisiniz?
"A" sütunundan itibaren boş sütun olmadığını varsayarak
s1.Range("V1:V" & x).AutoFilter Field:=22, Criteria1:="Aktif"

Kod:

Dim s1 As Worksheet, x As Long Application.ScreenUpdating = False Set s1 = Sheets(ActiveSheet.Name) x = s1.Cells(Rows.Count, "V").End(3).Row s1.AutoFilterMode = False s1.Range("V1").AutoFilter s1.Range("V1:V" & x).AutoFilter Field:=22, Criteria1:="Aktif" s1.Range("V2:V" & x).SpecialCells(xlCellTypeVisible).Cells.EntireRow.Delete s1.AutoFilterMode = False Application.ScreenUpdating = True

Sayın pilint toplam 17 dk da istenilen sonucu verdi

metin_0606 · 5 Şubat 2021

Seyit Tiken' Alıntı:
Bir de bu şekilde bir deneyiniz.

Kod:

For Each t In Range("A1:A8000").Cells If t.Value = "Aktif" Then t.Rows = "" End If Next t

Seyit bey 1743 kaydın 929 tanesini kısa bir sürede sildi ancak 814 tanesi kaldı

metin_0606 · 5 Şubat 2021

Seyit Tiken' Alıntı:
Bir de bu şekilde bir deneyiniz.

Kod:

For Each t In Range("A1:A8000").Cells If t.Value = "Aktif" Then t.Rows = "" End If Next t

Seyit bey makro sadece Aktif yazısını siliyor satırı silmiyor maalesef

Korhan Ayhan · 5 Şubat 2021

Merhaba,

Eğer tablonuzda formül içeren alan yoksa aşağıdaki yöntem oldukça hızlı sonuç verecektir.

Verilerinizin A2:V... aralığında olduğu varsayılmıştır.

Verilerinizi yedekleyerek deneyiniz.

C++:

Option Explicit

Sub Kosullu_Satir_Sil()
    Dim Zaman As Double, Veri As Variant, X As Long, Y As Byte
    Dim Son As Long, Say As Long, Silinen_Satir_Say As Long
  
    Zaman = Timer
  
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
  
    Son = Cells(Rows.Count, 1).End(3).Row
  
    If Son <= 2 Then Son = 3
  
    Veri = Range("A2:V" & Son).Value
  
    ReDim Liste(1 To Son, 1 To 22)
  
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 22) <> "Aktif" Then
            Say = Say + 1
            For Y = 1 To 22
                Liste(Say, Y) = Veri(X, Y)
            Next
        Else
            Silinen_Satir_Say = Silinen_Satir_Say + 1
        End If
    Next
  
    If Silinen_Satir_Say > 0 Then
        Range("A2:V" & Rows.Count).ClearContents
        Range("A2").Resize(Say, 22) = Liste
      
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
        MsgBox "Tablonuzdaki V sütununda ""Aktif"" ifadesini içeren satırlar temizlenmiştir." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
        MsgBox "Silinecek kayıt bulunamadı!", vbExclamation
    End If
End Sub

metin_0606 · 5 Şubat 2021

Korhan Ayhan' Alıntı:

Merhaba,

Eğer tablonuzda formül içeren alan yoksa aşağıdaki yöntem oldukça hızlı sonuç verecektir.

Verilerinizin A2:V... aralığında olduğu varsayılmıştır.

Verilerinizi yedekleyerek deneyiniz.

C++:

Option Explicit

Sub Kosullu_Satir_Sil()
    Dim Zaman As Double, Veri As Variant, X As Long, Y As Byte
    Dim Son As Long, Say As Long, Silinen_Satir_Say As Long
  
    Zaman = Timer
  
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
  
    Son = Cells(Rows.Count, 1).End(3).Row
  
    If Son <= 2 Then Son = 3
  
    Veri = Range("A2:V" & Son).Value
  
    ReDim Liste(1 To Son, 1 To 22)
  
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 22) <> "Aktif" Then
            Say = Say + 1
            For Y = 1 To 22
                Liste(Say, Y) = Veri(X, Y)
            Next
        Else
            Silinen_Satir_Say = Silinen_Satir_Say + 1
        End If
    Next
  
    If Silinen_Satir_Say > 0 Then
        Range("A2:V" & Rows.Count).ClearContents
        Range("A2").Resize(Say, 22) = Liste
      
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
        MsgBox "Tablonuzdaki V sütununda ""Aktif"" ifadesini içeren satırlar temizlenmiştir." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
        MsgBox "Silinecek kayıt bulunamadı!", vbExclamation
    End If
End Sub

Korhan Hocam listemde S,T ve U sütunlarında satır sonuna kadar formüller var. Makroyu denemem sonucunda makronun çok hızlı çalıştığını söyleyebilirim. Ancak son satırdaki veri koşula uymamasına rağmen onuda siliyor. Birde listemde C sütununda bulunan Bayan ve Erkek isimlerinde renklendirme var. Örneğin Erkek isimleri siyah renk, bayan isimleri Kırmızı renkte bulunmakta. İşlem sonucunda satır silmeden kaynaklı sanırım Erkek ve bayan isimlerinin renklerinde kaymalar oluyor. Yani kırmızı olması gereken siyah,siyah olması gereken kırmızı oluyor

Korhan Ayhan · 5 Şubat 2021

Sanal verilerle doldurduğunuz 10 satırlık bir örnek dosya paylaşırsanız çözüm üretilmesi kolaylaşır.

Formül ve biçim bakımından (satır-sütun-renklendirme) dosyanıza benzer olmasına dikkat etmeniz yeterli olacaktır.

metin_0606 · 5 Şubat 2021

Korhan Ayhan' Alıntı:
Sanal verilerle doldurduğunuz 10 satırlık bir örnek dosya paylaşırsanız çözüm üretilmesi kolaylaşır.

Formül ve biçim bakımından (satır-sütun-renklendirme) dosyanıza benzer olmasına dikkat etmeniz yeterli olacaktır.

Korhan hocam son dolu satırı A sütunu yerine B sütunundan aldırınca(count,2) en son satırdaki veriyi silmesi sorunu çözüldü. Ancak isimlerdeki renk kayması sorunu devam ediyor halen. Formülü silmesi olayını da ben elle düzeltirim sorun değil

Korhan Ayhan · 5 Şubat 2021

Bu kodu bir deneyip sonucu bildirir misiniz?

C++:

Option Explicit

Sub Satir_Sil()
    Dim X As Long, Veri As Variant, Son As Long, Alan As Range, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    Application.EnableEvents = 0
    
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
    
    Veri = Range("V1:V" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) = "Aktif" Then
            If Alan Is Nothing Then
                Set Alan = Cells(X, "V")
            Else
                Set Alan = Application.Union(Alan, Cells(X, "V"))
            End If
        End If
    Next
    
    If Not Alan Is Nothing Then
        Alan.EntireRow.Delete
        Application.EnableEvents = 1
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
        MsgBox "Silme işlemi tamamlanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        Application.EnableEvents = 1
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
        MsgBox "Silinecek satır bulunamadı!", vbExclamation
    End If
End Sub

metin_0606 · 5 Şubat 2021

Korhan Ayhan' Alıntı:

Bu kodu bir deneyip sonucu bildirir misiniz?

C++:

Option Explicit

Sub Satir_Sil()
    Dim X As Long, Veri As Variant, Son As Long, Alan As Range, Zaman As Double
 
    Zaman = Timer
 
    Application.ScreenUpdating = 0
 
    Son = Cells(Rows.Count, 2).End(3).Row
    If Son = 1 Then Son = 2
 
    Veri = Range("V1:V" & Son).Value
 
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) = "Aktif" Then
            If Alan Is Nothing Then
                Set Alan = Cells(X, "V")
            Else
                Set Alan = Application.Union(Alan, Cells(X, "V"))
            End If
        End If
    Next
 
    If Not Alan Is Nothing Then
        Alan.EntireRow.Delete
        Application.ScreenUpdating = 1
        MsgBox "Silme işlemi tamamlanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Silinecek satır bulunamadı!", vbExclamation
    End If
End Sub

Korhan Hocam istenilen sonucu 15 dk verdi. İsim renkleri ve formüller istenildiği gibiydi

Korhan Ayhan · 5 Şubat 2021

Dosyanızda çok fazla mı formül var. Dosyanızın boyutu nedir?

metin_0606 · 5 Şubat 2021

Sayfanın boyutu 7.57 mb. Ayrıca S,T ve U sütunlarında satır sonuna kadar formül var.

Koşullu Satır Silmek

metin_0606

ÖmerFaruk

Destek Ekibi

metin_0606

ÖmerFaruk

Destek Ekibi

PLİNT

metin_0606

metin_0606

PLİNT

Seyit Tiken

Uzman

metin_0606

metin_0606

metin_0606

Korhan Ayhan

Administrator

metin_0606

Korhan Ayhan

Administrator

metin_0606

Ekli dosyalar

Korhan Ayhan

Administrator

metin_0606

Korhan Ayhan

Administrator

metin_0606