- Katılım
- 1 Ekim 2017
- Mesajlar
- 694
- Excel Vers. ve Dili
- 2019 türkçe
- Altın Üyelik Bitiş Tarihi
- 06/10/2023
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Artış rakam olacak. C dede artış olabilir d dede.Merhaba,
Sorunuz net değil. Artış C de yazınca hemen karşısında D de mi artış olacak ve tarih mi olacak sayı mı olacak.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2:C10000]) Is Nothing Then Exit Sub
With Target
If .Count > 1 Then Exit Sub
If .Value = "" Then Cells(.Row, "AZ") = ""
If .Value <> "" Then
Cells(.Row, "AZ") = Date
Cells(.Row, "D") = 1
End If
End With
End Sub
Private Sub Workbook_Open()
Dim i As Long, deg As String
Sheets("Sayfa1").Select
Columns("AZ:AZ").EntireColumn.Hidden = True
For i = 2 To Cells(Rows.Count, "AZ").End(xlUp).Row
Cells(i, "D") = Cells(i, "D") + (Date - Cells(i, "AZ"))
If Cells(i, "D") = 20 Then
deg = deg & Chr(10) & i
End If
Next i
If deg <> "" Then
MsgBox "Aşağıdaki Satırlar 20.Güne Geldi" & Chr(10) & deg
End If
End Sub
Çok teşekkür ederim Ömer bey emeğinize sağlık.Çalışma mantığı;
C sütununa veri girdiğinizde sayaç aktif olur ve D sütununa 1 yazar. AZ sütununu makro yardımcı sütun olarak kullanarak AZ sütununa girilen değerin tarihini yazar.
Exceli açtığınızda çalışan makro sayaç görevi görür ve D sütununda 20 sayısına ulaşıldığında mesajla satırların numarasını size bildirir.
Sayfa1 kod bölümüne;
BuÇalışmaKitabı nın kod bölümüne;Kod:Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, [C2:C10000]) Is Nothing Then Exit Sub With Target If .Count > 1 Then Exit Sub If .Value = "" Then Cells(.Row, "AZ") = "" If .Value <> "" Then Cells(.Row, "AZ") = Date Cells(.Row, "D") = 1 End If End With End Sub
Kod:Private Sub Workbook_Open() Dim i As Long, deg As String Sheets("Sayfa1").Select Columns("AZ:AZ").EntireColumn.Hidden = True For i = 2 To Cells(Rows.Count, "AZ").End(xlUp).Row Cells(i, "D") = Cells(i, "D") + (Date - Cells(i, "AZ")) If Cells(i, "D") = 20 Then deg = deg & Chr(10) & i End If Next i If deg <> "" Then MsgBox "Aşağıdaki Satırlar 20.Güne Geldi" & Chr(10) & deg End If End Sub