Bugünden Öncesini Sil Bugünden Sonrasını Sil

[hakki83]

Merhabalar

Örnek dosyada RAPOR adlı sayfada, iki adet düğme vardır.

Bu düğmeler ile ANASAYFA’daki B2:AF10000 alanındaki yazılan isimleri,
Bugünden öncesini (Bugün hariç)
Ve
Bugünden sonrasını (Bugün dahil)
sildirebilir miyiz?

Alternarif kodlar olursa da çok sevinirim.

Teşekkürler.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Bugünden_Oncekileri_Temizle()
    Dim Bul As Range

    With Sheets("ANASAYFA")
        Set Bul = .Range("A:A").Find(Date)
        If Not Bul Is Nothing Then
            .Range("B2:AF" & Bul.Row - 1).ClearContents
        End If
        Set Bul = Nothing
    End With
End Sub

Sub Bugün_Dahil_Sonrakileri_Temizle()
    Dim Bul As Range

    With Sheets("ANASAYFA")
        Set Bul = .Range("A:A").Find(Date)
        If Not Bul Is Nothing Then
            .Range("B" & Bul.Row & ":AF10000").ClearContents
        End If
        Set Bul = Nothing
    End With
End Sub

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub Bugünden_Oncekileri_Temizle()
    Dim Bul As Variant

    With Sheets("ANASAYFA")
        Bul = Application.Match(CLng(Date), .Range("A:A"), 0)
        If Not IsError(Bul) Then
            .Range("B2:AF" & Bul - 1).ClearContents
        End If
    End With
End Sub

Sub Bugün_Dahil_Sonrakileri_Temizle()
    Dim Bul As Variant

    With Sheets("ANASAYFA")
        Bul = Application.Match(CLng(Date), .Range("A:A"), 0)
        If Not IsError(Bul) Then
            .Range("B" & Bul & ":AF10000").ClearContents
        End If
    End With
End Sub

 

[hakki83]

Korhan hocam emeğinize sağlık, tam tarif ettiğim gibi oldu. Teşekkürler.

 

[hakki83]

Diğerini de hemen deneyeyim.

 

[AdemCan]

Merhaba aynı işlem ancak hazırlamışken paylaşayım.

Private Sub CommandButton1_Click()
Dim s2 As Worksheet
Set s2 = Sayfa2
tarih = Date
Set bul = s2.Range("A:A").Find(tarih)

If Not bul Is Nothing Then
    s2.Range("B2:AF" & bul.Row - 1).ClearContents
End If
End Sub

Private Sub CommandButton2_Click()
Dim s2 As Worksheet, son As Long
Set s2 = Sayfa2
son = s2.Cells(Rows.Count, 1).End(3).Row
tarih = Date
Set bul = s2.Range("A:A").Find(tarih)

If Not bul Is Nothing Then
    s2.Range("B" & bul.Row & ":AF" & son).ClearContents
End If
End Sub

 

[hakki83]

Merhaba aynı işlem ancak hazırlamışken paylaşayım.

Private Sub CommandButton1_Click()
Dim s2 As Worksheet
Set s2 = Sayfa2
tarih = Date
Set bul = s2.Range("A:A").Find(tarih)

If Not bul Is Nothing Then
    s2.Range("B2:AF" & bul.Row - 1).ClearContents
End If
End Sub

Private Sub CommandButton2_Click()
Dim s2 As Worksheet, son As Long
Set s2 = Sayfa2
son = s2.Cells(Rows.Count, 1).End(3).Row
tarih = Date
Set bul = s2.Range("A:A").Find(tarih)

If Not bul Is Nothing Then
    s2.Range("B" & bul.Row & ":AF" & son).ClearContents
End If
End Sub

Emeğinize sağlık AdemCan hocam. Hemen deniyorum.

 

[Korhan Ayhan]

Başka bir alternatif;

Option Explicit

Sub Bugünden_Oncekileri_Temizle()
    Dim Bul As Variant

    With Sheets("ANASAYFA")
        On Error Resume Next
        Bul = WorksheetFunction.Match(CLng(Date), .Range("A:A"), 0)
        On Error GoTo 0
        If Not IsEmpty(Bul) Then
            .Range("B2:AF" & Bul - 1).ClearContents
        End If
    End With
End Sub

Sub Bugün_Dahil_Sonrakileri_Temizle()
    Dim Bul As Variant

    With Sheets("ANASAYFA")
        On Error Resume Next
        Bul = WorksheetFunction.Match(CLng(Date), .Range("A:A"), 0)
        On Error GoTo 0
        If Not IsEmpty(Bul) Then
            .Range("B" & Bul & ":AF10000").ClearContents
        End If
    End With
End Sub

 

[Korhan Ayhan]

Başka bir alternatif;

Option Explicit

Sub Bugünden_Oncekileri_Temizle()
    Dim X As Long, Bul As Long

    With Sheets("ANASAYFA")
        For X = 2 To .Cells(.Rows.Count, 1).End(3).Row
            If .Cells(X, 1) = Date Then
                Bul = X
                Exit For
            End If
        Next
        If Bul > 0 Then
            .Range("B2:AF" & Bul - 1).ClearContents
        End If
    End With
End Sub

Sub Bugün_Dahil_Sonrakileri_Temizle()
    Dim X As Long, Bul As Long

    With Sheets("ANASAYFA")
        For X = 2 To .Cells(.Rows.Count, 1).End(3).Row
            If .Cells(X, 1) = Date Then
                Bul = X
                Exit For
            End If
        Next
        If Bul > 0 Then
            .Range("B" & Bul & ":AF10000").ClearContents
        End If
    End With
End Sub

 

[hakki83]

Biigisayara geçince hemen deneyeceğim Korhan hocam