Soru 0 ve 0'dan Büyük Hücre Sayısını Sayma

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Herkese Merhaba
Aşağıdaki konularda yardim edebilecek olan varsa çok sevinirim.
Excel kitabımda HATIRLATMA adlı excel sayfası var
WorkBook Open Olayında

A2:A aralığına 07.02.2021 şeklinde tarih girilmekte
B2:B aralığında hatırtlatma konusu yazıyor
D1 hücresine bugünün tarihi yazacak Misal 07.02.2021


E1 hücresinde C2:C aralığında 0 dahil 0 ve 0'dan büyük kaç tane sayı varsa sayısını yazacak Misal aşağıdaki örnek için E1 hücresinde 5 yazmalı

C2:C aralığında bu gün itibari ile kaç gün kaldığı yazacak

Misal Bugün 07.02.2021
Tarih - Konu - Bugün İtibari İle Kalan Gün Sayısı

05.02.2021 - Doktor / -2 (Eksi 2) Gün
0602.2021 - Hayat / -1 (Eksi 1) Gün

07.02.2021 - Deneme / 0 Gün
10.02.2021 - Deneme2 / 3 Gün
11.02.2021 - Hatırlatma / 4 Gün
12.02.2021 - Sınav / 5 Gün

13.02.2021 - Günlük / 6 Gün
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,330
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Sub Test()
    Range("E1") = WorksheetFunction.CountIf(Range("C2:C" & Rows.Count), ">=0")
End Sub
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Korhan Hocam kodu deneyip bilgi vereyim
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Korhan Hocam kod çalıştı teşekkür ederim.

Su kışımsa da koda ihtiyacım var
A sütununda 08.02.2021 şeklinde tarih var
A sütununda yazılı tarihi D1 de yazan bu günden çıkararak GÜN olarak C sütununa yazmasını yapamadım .
Kod:
Sheets("HATIRLATMA").Range("D1") = Date

Sheets("HATIRLATMA").Range("E1") = WorksheetFunction.CountIf(Range("C2:C" & Rows.Count), ">=0") 'Hatırlatma Sayfası Hatırlatıcıyı Açmak İçin

 

SonSatır = Sheets("HATIRLATMA").Range("A65536").End(xlUp).Row

Dim i As Integer

For i = 2 To SonSatır

Sheets("HATIRLATMA").Range("C2") = Date - SonSatır
Misal Bugün 07.02.2021
Tarih - Konu - Bugün İtibari İle Kalan Gün Sayısı
05.02.2021 - Doktor / -2 (Eksi 2) C Sütununda
0602.2021 - Hayat / -1 (Eksi 1) Gün
07.02.2021 - Deneme / 0 Gün
10.02.2021 - Deneme2 / 3 Gün
11.02.2021 - Hatırlatma / 4 Gün
12.02.2021 - Sınav / 5 Gün
13.02.2021 - Günlük / 6 Gün
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Hocam
Kod:
Sheets("HATIRLATMA").Range("D1") = Date

Sheets("HATIRLATMA").Range("E1") = WorksheetFunction.CountIf(Range("C2:C" & Rows.Count), ">=0") 'Hatırlatma Sayfası Hatırlatıcıyı Açmak İçin
Bu kodu thisworbook
Workbook open olayın ekleyip exceli kapatıp açınca çalışmıyor
Ama excel açıkken vba da kodu çalıştırdığımda kod E1 Hücresine C2 c aralığında 0 ve 0 fan büyük kaç rakam varsa getirmiyor ilginç değil mi
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,330
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Eklediğiniz dosyada bahsettiğiniz kod yok. İlgili sayfa yok.
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Eklediğiniz dosyada bahsettiğiniz kod yok. İlgili sayfa yok.
Hocam dosyayı ekledim


Bu kodu thisworbook
Workbook open olayın ekleyip exceli kapatıp açınca çalışmıyor
Ama excel açıkken vba da kodu çalıştırdığımda kod E1 Hücresine C2 c aralığında 0 ve 0 fan büyük kaç rakam varsa getirmiyor ilginç değil mi
Hocam bu kısmı hallettim.

4. Mesajımdaki diğer kısımlar kaldı
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,330
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Private Sub Workbook_Open()
    With Sheets("HATIRLATMA")
        .Range("D1") = Date
        With .Range("C2:C" & .Cells(.Rows.Count, 1).End(3).Row)
            .Formula = "=D$1-A2"
            .Value = .Value
        End With
        .Range("E1") = WorksheetFunction.CountIf(.Range("C2:C" & .Rows.Count), ">=0")
    End With
End Sub
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Deneyiniz.

C++:
Private Sub Workbook_Open()
    With Sheets("HATIRLATMA")
        .Range("D1") = Date
        With .Range("C2:C" & .Cells(.Rows.Count, 1).End(3).Row)
            .Formula = "=D$1-A2"
            .Value = .Value
        End With
        .Range("E1") = WorksheetFunction.CountIf(.Range("C2:C" & .Rows.Count), ">=0")
    End With
End Sub
Hocam elinize emeğinize sağlık eliniz dert görmesin inşallah kodu aşağıdaki şekilde çalıştırdım.

Kod:
    With Sheets("HATIRLATMA")
        .Range("D1") = Date
        With .Range("C2:C" & .Cells(.Rows.Count, 1).End(3).Row)
            .Formula = "=A2-D$1"
            .Value = .Value
        End With
        .Range("E1") = WorksheetFunction.CountIf(.Range("C2:C" & .Rows.Count), ">=0")
    End With
Bu kodlarla C2 :C aralığını temizlemek istedim ama olmadı
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents


Hocam bir de
C2: C aralığında -3 ve daha yukarı yazıyorsa -4 gibi
O satırı komple silmesi mümkün müdür.
En son

.Range("E1") = WorksheetFunction.CountIf(.Range("C2:C" & .Rows.Count), ">=0")
işlemini yapsa
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
C2 C aralığını temizlemeyeceğiz. -3 olayını bulmak için
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,330
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Umarım doğru anlamışımdır.

C++:
Private Sub Workbook_Open()
    Dim Veri As Range, Alan As Range

    With Sheets("HATIRLATMA")
        .Range("D1") = Date
        .Range("C2:C" & .Rows.Count).ClearContents
        With .Range("C2:C" & .Cells(.Rows.Count, 1).End(3).Row)
            .Formula = "=A2-D$1"
            .Value = .Value
            For Each Veri In .Cells
                If Veri.Value <= -3 Then
                    If Alan Is Nothing Then
                        Set Alan = Veri
                    Else
                        Set Alan = Union(Alan, Veri)
                    End If
                End If
            Next
        End With
       
        If Not Alan Is Nothing Then Alan.EntireRow.Delete
       
        .Range("E1") = WorksheetFunction.CountIf(.Range("C2:C" & .Rows.Count), ">=0")
    End With
End Sub
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Korhan Hocam elinize emeğinize sağlık

.Range("C2:C" & .Rows.Count).ClearContents bu kısmı çıkarınca kod çalıştı.
Eliniz dert görmesin Hocam
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Sayın @Korhan Ayhan Hocam hatırlatma sayfasında 2. Satırdan itibaren hiç veri olmaması durumunda kod 1. Satırdaki verileri de siliyor.
1. Satırdaki verilerin silinmemesi için kodu nasıl revize edebiliriz.

Kod:
Private Sub Workbook_Open()
    Dim Veri As Range, Alan As Range

    With Sheets("HATIRLATMA")
        .Range("D1") = Date
        .Range("C2:C" & .Rows.Count).ClearContents
        With .Range("C2:C" & .Cells(.Rows.Count, 1).End(3).Row)
            .Formula = "=A2-D$1"
            .Value = .Value
            For Each Veri In .Cells
                If Veri.Value <= -3 Then
                    If Alan Is Nothing Then
                        Set Alan = Veri
                    Else
                        Set Alan = Union(Alan, Veri)
                    End If
                End If
            Next
        End With
      
        If Not Alan Is Nothing Then Alan.EntireRow.Delete
      
        .Range("E1") = WorksheetFunction.CountIf(.Range("C2:C" & .Rows.Count), ">=0")
    End With
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,330
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Private Sub Workbook_Open()
    Dim Veri As Range, Alan As Range
    
    With Sheets("HATIRLATMA")
        .Range("D1") = Date
        .Range("C2:C" & .Rows.Count).ClearContents
        If .Cells(.Rows.Count, 1).End(3).Row > 1 Then
            With .Range("C2:C" & .Cells(.Rows.Count, 1).End(3).Row)
                .Formula = "=A2-D$1"
                .Value = .Value
                For Each Veri In .Cells
                    If Veri.Value <= -3 Then
                        If Alan Is Nothing Then
                            Set Alan = Veri
                        Else
                            Set Alan = Union(Alan, Veri)
                        End If
                    End If
                Next
            End With
            
            If Not Alan Is Nothing Then Alan.EntireRow.Delete
            
            .Range("E1") = WorksheetFunction.CountIf(.Range("C2:C" & .Rows.Count), ">=0")
        End If
    End With
End Sub
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Deneyiniz.

C++:
Option Explicit

Private Sub Workbook_Open()
    Dim Veri As Range, Alan As Range
   
    With Sheets("HATIRLATMA")
        .Range("D1") = Date
        .Range("C2:C" & .Rows.Count).ClearContents
        If .Cells(.Rows.Count, 1).End(3).Row > 1 Then
            With .Range("C2:C" & .Cells(.Rows.Count, 1).End(3).Row)
                .Formula = "=A2-D$1"
                .Value = .Value
                For Each Veri In .Cells
                    If Veri.Value <= -3 Then
                        If Alan Is Nothing Then
                            Set Alan = Veri
                        Else
                            Set Alan = Union(Alan, Veri)
                        End If
                    End If
                Next
            End With
           
            If Not Alan Is Nothing Then Alan.EntireRow.Delete
           
            .Range("E1") = WorksheetFunction.CountIf(.Range("C2:C" & .Rows.Count), ">=0")
        End If
    End With
End Sub
Hocam elinize emeğinize sağlık kod çalıştı.
 
Üst