Soru Tarihe göre verileri silme

[mustafa]

Merhabalar, internette ve bu sitede yaptığım aramalarda benim istediğim şekilde bir çözüm bulamadığım için konuyu açıyorum.

B sütunu satır 6'dan satır 50.000'e kadar tarihler ve karşılarında veriler var. Tarihler bugünden geriye 2022 yılına kadar gidiyor. Tarih formatı 07.03.2025 şeklinde.

İstediğim şu; Bir buton ile istediğim yıllardaki tüm verileri sileyim. Örneğin 2022 ve 2023 verilerini silmek istiyorum, ya da sadece 2022 yılı verilerini silmek istiyorum şeklinde.

Ustalar için kolay benim için zor bir çözüm. Yardımcı olacaklara şimdiden teşekkür ederim.

 

[catalinastrap]

Satırların yanına yıl diye bir sütun açıp sütunlara tarihlerin yıllarını getirmelisin =YIL(B1) sonra bu sütuna filitre ekle ve istediğin yıllar süzülmüş olacaktır sonrası satır sil işlemi zaten

 

[Muzaffer Ali]

Merhaba.
Kod ile çözümlü dosya ektedir.

 

[mustafa]

Merhaba.
Kod ile çözümlü dosya ektedir.

Üstat eline sağlık, fakat sadece yıl dediğimde o yıla ait tüm verileri silinse olmaz mı? Örneğin açılan pencereye 2023 girdiğimde 2023 yılına ait tüm veriler silinsin. Böyle olursa benim için büyük kolaylık olacak.

 

[volki_112]

Üstat eline sağlık, fakat sadece yıl dediğimde o yıla ait tüm verileri silinse olmaz mı? Örneğin açılan pencereye 2023 girdiğimde 2023 yılına ait tüm veriler silinsin. Böyle olursa benim için büyük kolaylık olacak.

Muzaffer beyin kodlarını güncelledim. Sadece yıl giriyorsunuz. O yıla ait tüm verileri siler.

 

[Korhan Ayhan]

Bu da alternatif olsun..

Option Explicit

Sub Clear_Contents_Range()
    Dim WS As Worksheet, My_Date As Variant
    Dim Last_Row As Long, My_Year As Variant
    Dim First_Time As Double
    
    My_Date = InputBox("Lütfen silmek istediğiniz yılı yazınız!" & Chr(10) & Chr(10) & _
                       "Çoklu yıl silmek için aşağıdaki gibi yazınız..." & Chr(10) & Chr(10) & _
                       "2022,2023,2024,2025,2026", "YIL BAZLI SATIR SİLME İŞLEMİ", Year(Date))
    
    If My_Date = "" Then
        MsgBox "İşleminiz iptal edilmiştir."
        Exit Sub
    End If
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    First_Time = Timer
    
    Set WS = ActiveSheet
    
    Last_Row = WS.Cells(WS.Rows.Count, 2).End(3).Row
    
    For Each My_Year In Split(My_Date, ",")
        With WS.Range("B4:B" & Last_Row)
            .AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(0, "12/31/" & My_Year)
        End With
    
        On Error Resume Next
        WS.Range("B6:Y" & Last_Row).SpecialCells(xlCellTypeVisible).ClearContents
        On Error GoTo 0
    Next
    
    On Error Resume Next
    WS.ShowAllData
    On Error GoTo 0
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - First_Time, "0.00") & " Saniye", vbInformation
End Sub

 

[mustafa]

Hepinize çok teşekkür ederim, ellerinize sağlık.

 

[mustafa]

Kusura bakmayın, ilk başta dikkat etmemiştim, sonraki denemelerde fark ettim, sizin verdiğiniz kodlar satırı siliyor, oysa bana satırlardaki verilerin silinmesi (temizlenmesi) lazım. Satırlar aynen kalsın ama veriler temizlensin.

 

[Muzaffer Ali]

Delete yazan yeri ClearContents ile değiştirin.

 

[mustafa]

Şimdi oldu, teşekkür ederim.

Üstat bir şeyi daha eksik yazmışım; temizlenecek veriler B ve Y sütunları arasında.

Merak ettiğim için soracağım; Bu haliyle de işimi gördü ama açılan butonla birden fazla tarih silebilir miyiz? Örneğin buton açıldı 2022 ve 2023 yılına ait verilerin olduğu satırları temizleyeceğiz, bu mümkün mü?

 

[volki_112]

Şimdi oldu, teşekkür ederim.

Üstat bir şeyi daha eksik yazmışım; temizlenecek veriler B ve Y sütunları arasında.

Merak ettiğim için soracağım; Bu haliyle de işimi gördü ama açılan butonla birden fazla tarih silebilir miyiz? Örneğin buton açıldı 2022 ve 2023 yılına ait verilerin olduğu satırları temizleyeceğiz, bu mümkün mü?

7 nolu mesajdaki kod ile dediginiz sekilde iki yili yazip ayni anda silebilirsiniz

 

[Muzaffer Ali]

7. mesajdaki

WS.Range("B6:B" & Last_Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete

satırı silin aşağıdakini kopyalayın.

WS.Range("B6:Y" & Last_Row).SpecialCells(xlCellTypeVisible).ClearContents

 

[mustafa]

7. mesajdaki

WS.Range("B6:B" & Last_Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete

satırı silin aşağıdakini kopyalayın.

WS.Range("B6:Y" & Last_Row).SpecialCells(xlCellTypeVisible).ClearContents

Dediğinizi yaptım fakat verileri temizlemiyor, neyi eksik yapıyorum bulamadım.

 

[Muzaffer Ali]

Bu kodu deneyin.

Private Sub btnSatirSil_Click()
    Dim YilListesi  As String
    Dim Yil As Variant
    Dim Yillar As Variant
    Dim Bak As Long
    With Application
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    YilListesi = InputBox("Silmek istediğiniz yılları, virgülle ayırarak girin (örn: 2022, 2023, 2024):", "Yıl Girişi")
    If YilListesi = "" Then
        Exit Sub
        MsgBox "İptal edildi.", vbInformation
    End If
    Yillar = Split(YilListesi, ",")
    For Each Yil In Yillar
        For Bak = 6 To Cells(Rows.Count, "B").End(xlUp).Row
            If Cells(Bak, "B").Value >= CDate("1.1." & Yil) And Cells(Bak, "B").Value <= CDate("12.31." & Yil) Then
                Range("B" & Bak & ":Y" & Bak).ClearContents
            End If
        Next
    Next
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    MsgBox "İşlem tammalandı.", vbInformation
End Sub

 

[volki_112]

Dediğinizi yaptım fakat verileri temizlemiyor, neyi eksik yapıyorum bulamadım.

istediğin şekilde dosyanı düzenledim.

 

[mustafa]

Eyvallah, şimdi tam istediğim gibi oldu. Emek veren herkese çok teşekkür ederim.

 

[Korhan Ayhan]

Bütün ince detayları sonradan belirtmişsiniz. Böyle olunca paylaştığımız çözümler işlevsiz kalmış.

Sonradan verdiğiniz bilgilere göre #7 nolu mesajımı düzenledim. Dilerseniz deneyebilirsiniz.

 

[mustafa]

Bütün ince detayları sonradan belirtmişsiniz. böyle olunca paylaştığımız çözümler işlevsiz kalmış.

Sonradan verdiğiniz bilgilere göre #7 nolu mesajımı düzenledim. Dilerseniz deneyebilirsiniz.

Üstat çok haklısınız, elinize sağlık, teşekkür ederim.