Koşullu Satır Silmek

metin_0606 · 7 Şubat 2021

Korhan Ayhan' Alıntı:
Excel görev çubuğunda sol tarafta "Döngüsel Başvuru" yazıyor mu?

Korhan hocam listeme ayrı bir sütun ekleyerek (Önceden yapmak istediğim bir şeydi) Erkek olanlara "E" Bayan olanlara "K" harflerini getirerek isimlerdeki renk kaymasını 13 nolu makronun çalışmasından sonra kolayca düzenliyorum artık. 13 nolu mesajdaki makro işimi görüyor yardımlarınız için çok teşekkür ederim.

Korhan Ayhan · 7 Şubat 2021

Çözüme ulaşmanız güzel. Ama sorumun cevabını alamadım bir türlü.

metin_0606 · 7 Şubat 2021

Korhan Ayhan' Alıntı:
Çözüme ulaşmanız güzel. Ama sorumun cevabını alamadım bir türlü.

Örnek çalışmada sütunları V sütununa kadar almışım olması gereken w sütununa kadardı. Sanırım bu yüzden formüller döngüsele girmiş görünüyor

Korhan Ayhan · 7 Şubat 2021

Bu duruma uygun örnek dosya ve formül paylaşabilir misiniz?

Bir kod hazırlamıştım. Denemek istiyorum.

metin_0606 · 7 Şubat 2021

Korhan Ayhan' Alıntı:
Bu duruma uygun örnek dosya ve formül paylaşabilir misiniz?

Bir kod hazırlamıştım. Denemek istiyorum.

Korhan Ayhan · 7 Şubat 2021

Deneyiniz.

Renklendirme işlemini de koda ekledim.

İşlem süresini bildirirseniz sevinirim.

Not: Fiziksel olarak satır silme işlemi yapılmamaktadır. Veriler arka planda işlenip kritere uyan kayıtlar ilgili alan üzerine yeniden yazılmaktadır. Bu sebeple fiziksel satır silme yönteminden daha hızlı sonuç vermektedir.

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, 2).End(3).Row
  
    If Son <= 2 Then Son = 3
  
    Veri = Range("A2:X" & Son).Value
  
    ReDim Liste(1 To Son, 1 To 26)
  
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 23) <> "Aktif" Then
            Say = Say + 1
            For Y = 1 To 26
                If Y < 25 Then
                    Liste(Say, Y) = Veri(X, Y)
                ElseIf Y = 25 Then
                    Liste(Say, Y) = Cells(X + 1, 3).Font.Color
                ElseIf Y = 26 Then
                    Liste(Say, Y) = Cells(X + 1, 3).Interior.Color
                End If
            Next
        Else
            Silinen_Satir_Say = Silinen_Satir_Say + 1
        End If
    Next
  
    If Silinen_Satir_Say > 0 Then
        Range("A2:X" & Rows.Count).ClearContents
        Range("A2:X" & Rows.Count).Borders.LineStyle = 0
        Range("C2:C" & Rows.Count).Font.Color = xlNone
        Range("T2:T" & Rows.Count).Interior.Color = 16777215
        Range("A2:A" & Rows.Count).Interior.Color = 16777215
        Range("V2:V" & Rows.Count).FormatConditions.Delete
        
        Range("A2").Resize(Say, 24) = Liste
      
        Son = Cells(Rows.Count, 2).End(3).Row
        If Son <= 2 Then Son = 3
        
        Veri = Range("A2:X" & Son).Value
      
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            Cells(X + 1, 3).Font.Color = Liste(X, 25)
            Cells(X + 1, 3).Interior.Color = Liste(X, 26)
        Next
        
        Range("A2").Resize(Say, 24).Borders.LineStyle = 1
        Range("A2:A" & Cells(Rows.Count, 2).End(3).Row).Interior.Color = 5296274
        Range("T2:T" & Cells(Rows.Count, 2).End(3).Row).Interior.Color = 15773696
        
        With Range("V2:V" & Cells(Rows.Count, 2).End(3).Row)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=U2<0"
            .FormatConditions(1).Interior.Color = 255
            .FormatConditions(1).StopIfTrue = False
            
            .FormatConditions.Add Type:=xlExpression, Formula1:="=U2<30"
            .FormatConditions(2).Interior.Color = 65535
            .FormatConditions(2).StopIfTrue = False
        
            .FormatConditions.Add Type:=xlExpression, Formula1:="=U2>30"
            .FormatConditions(3).Interior.Color = 5296274
            .FormatConditions(3).StopIfTrue = False
        End With
        
        With Range("U2:U" & Cells(Rows.Count, 2).End(3).Row)
            .Formula = "=IF(T2="""","""",DAYS360($AD$1,T2))"
        End With
        
        With Range("V2:V" & Cells(Rows.Count, 2).End(3).Row)
            .Formula = "=IF(T2="""","""",IF(0>U2,""SURESI DOLDU"","""")&"" ""&IF(U2<30,""(UYARI)"","""")&""""&IF(U2>30,""GECERLI"","""")&"""")"
        End With
        
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
        MsgBox "Tablonuzdaki W 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 · 7 Şubat 2021

Korhan Ayhan' Alıntı:

Deneyiniz.

Renklendirme işlemini de koda ekledim.

İşlem süresini bildirirseniz sevinirim.

Not: Fiziksel olarak satır silme işlemi yapılmamaktadır. Veriler arka planda işlenip kritere uyan kayıtlar ilgili alan üzerine yeniden yazılmaktadır. Bu sebeple fiziksel satır silme yönteminden daha hızlı sonuç vermektedir.

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, 2).End(3).Row
 
    If Son <= 2 Then Son = 3
 
    Veri = Range("A2:X" & Son).Value
 
    ReDim Liste(1 To Son, 1 To 26)
 
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 23) <> "Aktif" Then
            Say = Say + 1
            For Y = 1 To 26
                If Y < 25 Then
                    Liste(Say, Y) = Veri(X, Y)
                ElseIf Y = 25 Then
                    Liste(Say, Y) = Cells(X + 1, 3).Font.Color
                ElseIf Y = 26 Then
                    Liste(Say, Y) = Cells(X + 1, 3).Interior.Color
                End If
            Next
        Else
            Silinen_Satir_Say = Silinen_Satir_Say + 1
        End If
    Next
 
    If Silinen_Satir_Say > 0 Then
        Range("A2:X" & Rows.Count).ClearContents
        Range("A2:X" & Rows.Count).Borders.LineStyle = 0
        Range("C2:C" & Rows.Count).Font.Color = xlNone
        Range("T2:T" & Rows.Count).Interior.Color = 16777215
        Range("A2:A" & Rows.Count).Interior.Color = 16777215
        Range("V2:V" & Rows.Count).FormatConditions.Delete
       
        Range("A2").Resize(Say, 24) = Liste
     
        Son = Cells(Rows.Count, 2).End(3).Row
        If Son <= 2 Then Son = 3
       
        Veri = Range("A2:X" & Son).Value
     
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            Cells(X + 1, 3).Font.Color = Liste(X, 25)
            Cells(X + 1, 3).Interior.Color = Liste(X, 26)
        Next
       
        Range("A2").Resize(Say, 24).Borders.LineStyle = 1
        Range("A2:A" & Cells(Rows.Count, 2).End(3).Row).Interior.Color = 5296274
        Range("T2:T" & Cells(Rows.Count, 2).End(3).Row).Interior.Color = 15773696
       
        With Range("V2:V" & Cells(Rows.Count, 2).End(3).Row)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=U2<0"
            .FormatConditions(1).Interior.Color = 255
            .FormatConditions(1).StopIfTrue = False
           
            .FormatConditions.Add Type:=xlExpression, Formula1:="=U2<30"
            .FormatConditions(2).Interior.Color = 65535
            .FormatConditions(2).StopIfTrue = False
       
            .FormatConditions.Add Type:=xlExpression, Formula1:="=U2>30"
            .FormatConditions(3).Interior.Color = 5296274
            .FormatConditions(3).StopIfTrue = False
        End With
       
        With Range("U2:U" & Cells(Rows.Count, 2).End(3).Row)
            .Formula = "=IF(T2="""","""",DAYS360($AD$1,T2))"
        End With
       
        With Range("V2:V" & Cells(Rows.Count, 2).End(3).Row)
            .Formula = "=IF(T2="""","""",IF(0>U2,""SURESI DOLDU"","""")&"" ""&IF(U2<30,""(UYARI)"","""")&""""&IF(U2>30,""GECERLI"","""")&"""")"
        End With
       
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
        MsgBox "Tablonuzdaki W 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 29 sn işlemi istenilen sonuçta bitirdi. Emeğinize sağlık hakkınızı helal edin yordum sizi

Korhan Ayhan · 7 Şubat 2021

Ben sizin örnek dosyanızı 20.000 satıra kadar çoğalttım. Kodu bu haliyle denediğimde bende 1,3 saniye civarında sonuç verdi.

Ben İ5 6. Nesil işlemci ve 8 GB Ram ile bu sonucu alıyorum. Sanırım sizin dosyanızda başka bir sorun var.

metin_0606 · 7 Şubat 2021

Korhan Ayhan' Alıntı:
Ben sizin örnek dosyanızı 20.000 satıra kadar çoğalttım. Kodu bu haliyle denediğimde bende 1,3 saniye civarında sonuç verdi.

Ben İ5 6. Nesil işlemci ve 8 GB Ram ile bu sonucu alıyorum. Sanırım sizin dosyanızda başka bir sorun var.

Korhan Hocam ben bunu evdeki bilgisayarımda denedim. 4 gb ramı var. İşyerindeki bilgisayarda daha hızlı sonuç alacağım kesinlikle. Yarin iş yerindeki bilgisayarımda deneyeceğim

sahra01 · 15 Eylül 2022

ÖmerFaruk' 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

çok teşekkürler hocam çok sağolun beni nasıl bir dertten kurtardığınızı bilemezsiniz

ahmetinal.95 · 15 Eylül 2022

Merhabalar,

Ben daha önce benzer bir şeyi yapmak durumunda kalıyordum. Veriyi ilgili kriterle filtreleyip (mesela bu örnekte AKTİF yazılı satırları ekran getirip) hepsini Shift+Space seçip Ctrl+- ile temizleyebiliyordum. Başka bir durum mu var yoksa makroyla çözülmesi şart bir durum muydu?

Korhan Ayhan · 15 Eylül 2022

Merhaba,

@ahmetinal.95 sizin bahsettiğiniz yöntemde satır silmek için elbette kullanılabilir. Çoğu zaman arkadaşlarımız bu sorunları için makro ile çözüm talep ediyorlar. Hatta @Necdet bey bu tarz sorulara çoğunlukla filtre uygulayıp silebilirsiniz şeklinde cevap vermektedir.

Koşullu Satır Silmek

metin_0606

Korhan Ayhan

Administrator

metin_0606

Korhan Ayhan

Administrator

metin_0606

Ekli dosyalar

Korhan Ayhan

Administrator

metin_0606

Korhan Ayhan

Administrator

metin_0606

sahra01

ahmetinal.95

Korhan Ayhan

Administrator