belli tarihe gelince satır silme

Erkan Akayay

Altın Üye
Katılım
8 Aralık 2006
Mesajlar
405
Excel Vers. ve Dili
Ofis 365 TR 64 Bit
Altın Üyelik Bitiş Tarihi
21-11-2028
Private Sub Worksheet_Change(ByVal Target As Range)
If [A1] = "27.12.2006" Then
[A1].EntireRow.Delete
End If
End Sub
 
Katılım
2 Aralık 2005
Mesajlar
10
tam istediğim şu şekilde birşey hücre tarihi bugünün tarihinden geçerse otomatik o hücrenin bulunduğu satırı silecek
 
Katılım
13 Aralık 2006
Mesajlar
3
Excel Vers. ve Dili
Excel 2003
oncelikle bu makroyu bos bir excel dosyasında test ettikten sonra orijinal dosya icerisinde denemelisin.

bos bir excel dosyası ac. A kolonuna 20 civarinda tarih yaz.
01.01.2005
01.02.2006
10.02.2006
14.12.2006
15.12.2007
15.12.2010
...

sadece tarihlerin bulundugu hucreleri sec. sonra seciliyken. Makroyu calistir.
bugunun tarihinden buyuk olan tarihlere ait satirlari silinecektir.


asagida "now" yazan yere istediğin tarihi cift tırnak icerisinde yazabilirsin.


Sub SatirlariSil()
'secilen satir sayisi
Rng = Selection.Rows.Count
ActiveCell.Offset(0, 0).Select
Application.ScreenUpdating = False


For i = 1 To Rng

'eger aktif hucrenin degeri bugunden buyukse
If ActiveCell.Value > Now Then

'secime ait tum satiri sil
Selection.EntireRow.Delete

'degil ise
Else
'bir sonraki hucreyi sec
ActiveCell.Offset(1, 0).Select
End If
Next i
Application.ScreenUpdating = True
End Sub
 
Katılım
14 Şubat 2006
Mesajlar
3,426
Excel Vers. ve Dili
(Excel 2016 - İngilizce)
Altın Üyelik Bitiş Tarihi
30-11-2022
Aşağıdaki kodları bugünden önceki verilerinizi manuel silmek için kullanabilirsiniz.

Kod:
Sub SatirSil()
Dim i As Long
Application.ScreenUpdating = False
[a1].Select
son = [a65536].End(3).Row
For i = son To 1 Step -1
If CDate(Cells(i, 1).Value) < Date Then Rows(i).EntireRow.Delete Shift:=xlUp
Next i
[a1].Select
Application.ScreenUpdating = True
End Sub
Eğer her dosya açıldığında otomatik olarak silinmesini istiyorsanız,
Kod:
Sub Auto_Openl()
Dim i As Long
Application.ScreenUpdating = False
Sheets("VERİ").Select
[a1].Select
son = [a65536].End(3).Row
For i = son To 1 Step -1
If CDate(Cells(i, 1).Value) < Date Then Rows(i).EntireRow.Delete Shift:=xlUp
Next i
[a1].Select
Application.ScreenUpdating = True
End Sub
 
Üst