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:
Sub kalan_zaman()
Dim i As Date, s As Date, g As Integer, t As Long, z As Date, c As Long, k As Date
Dim h As Double, a As Integer, y As Integer, j As Long, jj As Long, nn As String, pl As Range
Set s1 = Sheets("ŞABLON")
For Each pl In s1.Range("C28")
If IsDate(pl) = True And pl <> "" Then
i = CDate(Date): s = CDate(pl)
If CDate(i) > CDate(s) Then s1.Cells(pl.Row, "F") = "GEÇMİŞ": GoTo 10
t = Month(i): g = -1
z = DateSerial(Year(CDate(i)), Month(CDate(i)) + 1, 0)
If Day(i) = Day(z) Then j = 1
For c = CDbl(i) To CDbl(s)
g = g + 1
k = DateSerial(Year(CDate(c)), Month(CDate(c)) + 1, 0)
If Month(CDate(c)) <> t Then
If Day(k) = Day(CDate(c)) Then jj = j + 1
If Day(i) = Day(CDate(c)) Then h = True
If Day(k) < Day(z) And Day(CDate(c)) = Day(k) Then h = True
If jj = 2 Then h = True
End If
If h = True Then
t = Month(CDate(c))
a = a + 1
g = 0
h = 0
jj = j
End If
If a = 12 Then
y = y + 1: a = 0
End If
Next
If g > 0 Then nn = g & " GÜN"
If a > 0 Then nn = a & " AY"
If y > 0 Then nn = y & " YIL"
s1.Cells(pl.Row, "F") = nn
End If
10:
g = 0: a = 0: y = 0
Next pl
End Sub
Örnek : ŞABLON sayfasından 147 tane kopya oluşturdum ve her sayfaya farklı ad verdim. Her sayfanın adını da C2 hücresine yazdım.
Makronun sayfa adına göre de aktif çalışmasını nasıl sağlayabilirim?
