Soru makro topla

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,539
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim yil As Integer, ay As Byte, gun As Byte
    On Error Resume Next
If Not Intersect(Target, Range("B9:C20")) Is Nothing Then
        sat = Target.Row
    If Cells(sat, "B") = Empty Then
        Cells(sat, "D") = Empty
        Cells(sat, "E") = Empty
        Cells(sat, "F") = Empty
        Cells(sat, "S") = Empty
      If Cells(sat, "C") = Empty Then
        Cells(sat, "D") = Empty
        Cells(sat, "E") = Empty
        Cells(sat, "F") = Empty
        Cells(sat, "S") = Empty
        End If
    Else
    Dim Tarih1 As Date, Tarih2 As Date
    Tarih1 = CDate(Cells(sat, "B"))
    Tarih2 = CDate(Cells(sat, "C"))
    Yıl = DateDiff("yyyy", Cells(sat, "B"), Cells(sat, "C"))
    ay = DateDiff("m", Cells(sat, "B"), Cells(sat, "C")) + (Day(Cells(sat, "B")) > Day(Cells(sat, "C")))
    Yıl = Yıl + ((ay - Yıl * 12) < 0)
    ay = ay Mod 12
    GÜN = DateDiff("d", Cells(sat, "B"), Cells(sat, "C")) - DateDiff("d", Cells(sat, "B"), _
    DateAdd("yyyy", Yıl, DateAdd("m", ay, Cells(sat, "B"))))
    Cells(sat, "D") = Yıl
    Cells(sat, "E") = ay
    Cells(sat, "F") = GÜN
    Cells(sat, "S") = Yıl & " Yıl " & ay & " Ay " & GÜN & " Gün"
     son = Cells(Rows.Count, "S").End(3).Row
     [S21] = HizmetTopla(Range("S9:S" & son))
    End If
    End If
End Sub
son = Cells(Rows.Count, "S").End(3).Row
[S21] = HizmetTopla(Range("S9:S" & son))
kod satırı şu haliyle sadece B9:C9 hücresine tarih girince aktif oluyor.


Bu şeklini B9:C20 aralığında tarih girdiği zaman aktif olması,
Bir satıra da tarih girilse, On satıra da tarih girilse ya da altında ki veya üstünde ki satırlarda ki tarihler silinse dahi kodun çalışma için nasıl düzenleme yapılmalı?
Yardımcı olabilir misiniz?
 

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
3,198
Excel Vers. ve Dili
Office 2013 İngilizce
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim yil As Integer, ay As Byte, gun As Byte
    On Error Resume Next
If Not Intersect(Target, Range("B9:C20")) Is Nothing Then
        sat = Target.Row
    If Cells(sat, "B") = Empty Then
        Cells(sat, "D") = Empty
        Cells(sat, "E") = Empty
        Cells(sat, "F") = Empty
        Cells(sat, "S") = Empty
      If Cells(sat, "C") = Empty Then
        Cells(sat, "D") = Empty
        Cells(sat, "E") = Empty
        Cells(sat, "F") = Empty
        Cells(sat, "S") = Empty
        End If
    Else
    Dim Tarih1 As Date, Tarih2 As Date
    Tarih1 = CDate(Cells(sat, "B"))
    Tarih2 = CDate(Cells(sat, "C"))
    Yıl = DateDiff("yyyy", Cells(sat, "B"), Cells(sat, "C"))
    ay = DateDiff("m", Cells(sat, "B"), Cells(sat, "C")) + (Day(Cells(sat, "B")) > Day(Cells(sat, "C")))
    Yıl = Yıl + ((ay - Yıl * 12) < 0)
    ay = ay Mod 12
    GÜN = DateDiff("d", Cells(sat, "B"), Cells(sat, "C")) - DateDiff("d", Cells(sat, "B"), _
    DateAdd("yyyy", Yıl, DateAdd("m", ay, Cells(sat, "B"))))
    Cells(sat, "D") = Yıl
    Cells(sat, "E") = ay
    Cells(sat, "F") = GÜN
    Cells(sat, "S") = Yıl & " Yıl " & ay & " Ay " & GÜN & " Gün"
     son = Cells(Rows.Count, "S").End(3).Row
     [S21] = HizmetTopla(Range("S9:S" & son))
    End If
    End If
End Sub
son = Cells(Rows.Count, "S").End(3).Row
[S21] = HizmetTopla(Range("S9:S" & son))
kod satırı şu haliyle sadece B9:C9 hücresine tarih girince aktif oluyor.


Bu şeklini B9:C20 aralığında tarih girdiği zaman aktif olması,
Bir satıra da tarih girilse, On satıra da tarih girilse ya da altında ki veya üstünde ki satırlarda ki tarihler silinse dahi kodun çalışma için nasıl düzenleme yapılmalı?
Yardımcı olabilir misiniz?
Örnek dosya eklerseniz daha hızlı cevap alabilirsiniz.
 
Üst