Soru Makro İle Tarih Hesaplama

H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Ekli örnek dosyada "T" sütunun da izin başlangıç tarihi var. Benim yapmak istediğim,
1-AF1 hücresine tarih girdiğim zaman izin başlangıç tarihindeki zamanı AA hücresine ödeme tarihini atacak.
2-S sütununda izin Bedelli ve Y sütununda Aktif ise AB hücresine Bugünün Tarihi-Ödeme Tarihi = .... Gün Kaldı veya ....Gün Geçti Yazacak.
3-İzin Pasif İse hiç bir şey yazmayacak
4-Hesaplama işlemi en son satıra kadar olacak

İndir Hesap

Dosyayı indir Hesap
dosya.co
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Kodu bir module ekleyip butana atayabilirsin.
C++: 
Sub TarihHesapla()
Dim Veri As Variant, Liste, i As Long, k As Integer, Deger As Date
    With Worksheets("KAYITLAR")
        Deger = .Range("AF1")
        If Not IsDate(Deger) Then Exit Sub
        son = .Range("P" & Rows.Count).End(3).Row
        If son < 4 Then Exit Sub
        Veri = .Range("P4:AB" & son).Value
        ReDim Liste(1 To UBound(Veri, 1), 1 To UBound(Veri, 2))
        For i = 1 To UBound(Veri)
            For k = 1 To UBound(Veri, 2)
                Liste(i, k) = Veri(i, k)
            Next k
            If Veri(i, 4) = "Bedelli" And Veri(i, 10) = "Aktif" Then
                Liste(i, 12) = Liste(i, 5)
                Liste(i, 13) = Date - Liste(i, 12)
                If Liste(i, 13) < 0 Then
                   Liste(i, 13) = Liste(i, 13) & " Gün Geçti"
                Else
                   Liste(i, 13) = Liste(i, 13) & " Gün Kaldı"
                End If
            End If
        Next i
        .Range("P4").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Liste
        Erase Liste
    End With
End Sub
 
H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Ömer hocam merhabalar
Hesaplamada sıkıntı var galiba .
Örneğin: T4 hücresinde 20.02.1998 tarihi var Ben AF1 hücresine 01.01.2023 yazdığım zaman makro AA4 hücresine 20.02.1998 değilde 20.02.2023 yazacak .Gün Geçti,Gün Kaldı 20.02.2023-Bugün olarak hesaplayacak
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
İlk mesajınızda böyle demiyordunuz.

AF1 hücresine tarih girdiğim zaman izin başlangıç tarihindeki zamanı AA hücresine ödeme tarihini atacak.
AB hücresine Bugünün Tarihi-Ödeme Tarihi = .... Gün Kaldı veya ....Gün Geçti Yazacak.

Çözüm basit ama dün gece de aynı şekilde sorunuzun içeriğini değiştirdiniz.
Biraz düşünün doğruya karar verin ve ne istiyorsanız onu sorun.
 
H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Hocam çok özür diliyorum. Yanlış izah etmişim. Bugün inceleyince farkına vardım. Doğrusu 3 nolu mesajımdaki gibi olacak
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Böyle demişsiniz.
Örneğin: T4 hücresinde 20.02.1998 tarihi var Ben AF1 hücresine 01.01.2023 yazdığım zaman makro AA4 hücresine 20.02.1998 değilde 20.02.2023 yazacak

Eksik ifade ediyorsunuz. Şubat ayının özelinde bir şey daha söylemelisiniz.
Mesela
T4 hücresinde 29.02.2020 tarihi var Ben AF1 hücresine 01.01.2023 yazdığı zaman makro AA4 hücresine 29.02.2023 mü yazacak? Böyle bir tarih yok.
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
29.02.2023 gibi olmayan bir tarih olacak yani öyle mi?
Anlamak ve anlaşılmak zorlaşıyor gittikçe.

Son olarak aşağıdaki kodu vereceğim ve konuyu kapatacağım.
C++: 
Sub TarihHesapla()
Dim Veri As Variant, Liste, i As Long, k As Integer, Deger As Date
    With Worksheets("KAYITLAR")
        Deger = .Range("AF1")
        If Not IsDate(Deger) Then Exit Sub
        son = .Range("P" & Rows.Count).End(3).Row
        If son < 4 Then Exit Sub
        Veri = .Range("P4:AB" & son).Value
        ReDim Liste(1 To UBound(Veri, 1), 1 To UBound(Veri, 2))
        For i = 1 To UBound(Veri)
            For k = 1 To UBound(Veri, 2)
                Liste(i, k) = Veri(i, k)
            Next k
            If Veri(i, 4) = "Bedelli" And Veri(i, 10) = "Aktif" Then
                Liste(i, 12) = DateAdd("y", Year(Deger) - Year(Liste(i, 5)), Liste(i, 5))
                Liste(i, 13) = Liste(i, 12) - Date
                If Liste(i, 13) < 0 Then
                   Liste(i, 13) = Liste(i, 13) & " Gün Geçti"
                Else
                   Liste(i, 13) = Liste(i, 13) & " Gün Kaldı"
                End If
            End If
        Next i
        .Range("P4").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Liste
        Erase Liste
    End With
End Sub
 
H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Hocam maelesef ollmadı
T4 hücresinde örneğin :07/05/1998 var
AF1 hücresinde örneğin:01.01.2021 var
AA4 hücresine makro =07/05/2021 yazması gerekiyor.
AB4 hücresinde ise =Bugün(23.12.2021)-07.05.2021 =-230 gün Geçti Yazmalı
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Aşağıdaki satırı düzeltebilirmisiniz?
"y" olan yeri "yyyy" yapacaksınız
C++: 
Liste(i, 12) = DateAdd("y", Year(Deger) - Year(Liste(i, 5)), Liste(i, 5))
 
H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Hocam çok çok özür diliyorum. Dalgınlığıma bağışlayın. Bir şeyi unutmuşum. P hücresinde Ödendi yazarsa AB hücresine de "Ödendi " şeklinde kodu son olarak siz uğraştırmayacaksa revize etmeniz mümkün mü ?
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
C++: 
Sub TarihHesapla()
Dim Veri As Variant, Liste, i As Long, k As Integer, Deger As Date
    With Worksheets("KAYITLAR")
        Deger = .Range("AF1")
        If Not IsDate(Deger) Then Exit Sub
        son = .Range("P" & Rows.Count).End(3).Row
        If son < 4 Then Exit Sub
        Veri = .Range("P4:AB" & son).Value
        ReDim Liste(1 To UBound(Veri, 1), 1 To UBound(Veri, 2))
        For i = 1 To UBound(Veri)
            For k = 1 To UBound(Veri, 2)
                Liste(i, k) = Veri(i, k)
            Next k
            If Veri(i, 4) = "Bedelli" And Veri(i, 10) = "Aktif" Then
                Liste(i, 12) = DateAdd("yyyy", Year(Deger) - Year(Liste(i, 5)), Liste(i, 5))
                Liste(i, 13) = Liste(i, 12) - Date
                If Liste(i, 1) = "Ödendi" Then
                    Liste(i, 13) = "Ödendi"
                ElseIf Liste(i, 12) - Date < 0 Then
                   Liste(i, 13) = Liste(i, 12) - Date & " Gün Geçti"
                Else
                   Liste(i, 13) = Liste(i, 12) - Date & " Gün Kaldı"
                End If
            End If
        Next i
        .Range("P4").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Liste
        Erase Liste
    End With
End Sub
 
H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Ömer hocam merhabalar;
Makro çok güzel çalışıyor. Öncelikle tekrar tekrar teşekkür ederim. Ufak bir yerde sıkıntı var gibi. Sütunlar üzerinde değişiklik yapı uygula dediğimde eski kayıtlar silmiyor. Aşağıdaki gibi
Ödendi>Bedelli>Aktif>Ödendi Burda sıkıntı yok
Ödenmedi>Bedelli>Aktif>184 Gün Kaldı Burda da sıkıntı yok
Ödenmedi>Bedelli>Pasif>184 Gün Kaldı Burayı Boş göstermesi gerekirken Eski Kayıtı silmiyor.
Ödenmedi>Bedelsiz>Pasif184 Gün Kaldı Burayı Boş göstermesi gerekirken Eski Kayıtı silmiyor.
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Daha önceki hiç bir mesajınızda silinmeyle alakalı bir not göremedim.
Sanırım bunu ilave istiyorsunuz.

Kodların içindeki IF-THEN bölümüne ufak bir ilave yaparsanız olacaktır.
Bedelli ya da Aktif değilse AB sütunundaki içeri siler.

C++: 
            If Veri(i, 4) = "Bedelli" And Veri(i, 10) = "Aktif" Then
                Liste(i, 12) = Liste(i, 5)
                Liste(i, 13) = Date - Liste(i, 12)
                If Liste(i, 13) < 0 Then
                   Liste(i, 13) = Liste(i, 13) & " Gün Geçti"
                Else
                   Liste(i, 13) = Liste(i, 13) & " Gün Kaldı"
                End If
            Else 'İlave satır 1'
            Liste(i, 13) = "" 'İlave satır 2'
            End If
 
H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Hocam bu seferde ödendi >Bedelli >Aktif olduğu zaman AB hücresine "Ödendi" Yazması gerekirken yazmıyor.
Kod: 
Sub TarihHesapla()
Dim Veri As Variant, Liste, i As Long, k As Integer, Deger As Date
    With Worksheets("KAYITLAR")
        Deger = .Range("AF1")
        If Not IsDate(Deger) Then Exit Sub
        son = .Range("P" & Rows.Count).End(3).Row
        If son < 4 Then Exit Sub
        Veri = .Range("P4:AB" & son).Value
        ReDim Liste(1 To UBound(Veri, 1), 1 To UBound(Veri, 2))
        For i = 1 To UBound(Veri)
            For k = 1 To UBound(Veri, 2)
                Liste(i, k) = Veri(i, k)
            Next k
            If Veri(i, 4) = "Bedelli" And Veri(i, 10) = "Aktif" Then
                Liste(i, 12) = Liste(i, 5)
                Liste(i, 13) = Date - Liste(i, 12)
                If Liste(i, 13) < 0 Then
                   Liste(i, 13) = Liste(i, 13) & " Gün Geçti"
                Else
                   Liste(i, 13) = Liste(i, 13) & " Gün Kaldı"
                End If
            Else
            Liste(i, 13) = ""
                
            End If
        Next i
        .Range("P4").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Liste
        Erase Liste
    End With
End Sub
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Bir şeye dikkat ediyor musunuz?

Neredeyse her mesajınızda sanki daha önceden bunu istemiş ama olmuyormuş gibi benden düzeltme istiyorsunuz.
Her defasında siz ilave bir şey istemeyip tek seferde düzgün ve eksiksiz istekleriniz yazsanız çok daha hoş olur.

Kolay gelsin.
 
H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Son makroyu ilave edince oldu. Ondan önce çalışıyordu. Kusura bakmayın
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Benim verdiğim koddaki ilave ELSE satırı sadece örnek olsun diyeydi. Siz asıl kodlarınıza ilave edecektiniz ama mesajdaki kodu olduğu gibi kullanmışsınız. Benim hatam.
Kodların tamamını paylaşıyorum.
C++: 
Sub TarihHesapla()
Dim Veri As Variant, Liste, i As Long, k As Integer, Deger As Date
    With Worksheets("KAYITLAR")
        Deger = .Range("AF1")
        If Not IsDate(Deger) Then Exit Sub
        son = .Range("P" & Rows.Count).End(3).Row
        If son < 4 Then Exit Sub
        Veri = .Range("P4:AB" & son).Value
        ReDim Liste(1 To UBound(Veri, 1), 1 To UBound(Veri, 2))
        For i = 1 To UBound(Veri)
            For k = 1 To UBound(Veri, 2)
                Liste(i, k) = Veri(i, k)
            Next k
            If Veri(i, 4) = "Bedelli" And Veri(i, 10) = "Aktif" Then
                Liste(i, 12) = DateAdd("yyyy", Year(Deger) - Year(Liste(i, 5)), Liste(i, 5))
                Liste(i, 13) = Liste(i, 12) - Date
                If Liste(i, 1) = "Ödendi" Then
                    Liste(i, 13) = "Ödendi"
                ElseIf Liste(i, 12) - Date < 0 Then
                   Liste(i, 13) = Liste(i, 12) - Date & " Gün Geçti"
                Else
                   Liste(i, 13) = Liste(i, 12) - Date & " Gün Kaldı"
                End If
            Else
                Liste(i, 13) = ""
            End If
        Next i
        .Range("P4").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Liste
        Erase Liste
    End With
End Sub
 
H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Çok teşekkür ediyorum. Alllah razı olsun. Emeğinize sağlık
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst