Hücrede yapılan değişikliğe göre tarih atlatma

berkbaba

Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Es Selamün Aleyküm.
Forumda bulunan tüm kardeşlerimin Geçmiş kurban bayramı' nı kutlarım. Cenab-ı Allah Azze ve Celle sağlıklı bir ömür ile daha nice bayramlar görmenizi nasip etsin inşallah.

Ekli listede bir sorum olacak.
Sarı renkli olan sütunda bulunan hücrelerde değişiklik yaptığım zaman önceki tarihi bir yıl atlatacak bir makroya ihtiyacım var.
Örnek olması babında;
O - P - Q sütunlarının 3. satırında 1 - 1 - 1 değerleri var. S sütunlarının 3. satırında da tarih (14.05.2016) mevcut.
X sütunlarının 3. satırında değişiklik yaptığım zaman Z sütunlarının 3. satırına 14.05.2017 yazacak.
Rica etsem yardımcı olabilir misiniz?
Ves Selam Veddua
 
Klasör İçindeki Kapalı Dosyadan Veri Say
Excel ile Kolayca Listeleme

Ekli dosyalar

Tarihe göre sırala Oylamaya göre sırala
İlgili sayfanın kod bölümüne yapıştırınız.
VBA: 
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
[COLOR=rgb(132, 53, 52)]son [/COLOR]= [O2].End(xlDown).Row: [COLOR=rgb(132, 53, 52)]sat [/COLOR]= Target.Row: [COLOR=rgb(132, 53, 52)]sut [/COLOR]= Target.Column
[COLOR=rgb(132, 53, 52)]alan [/COLOR]= Range("X3:X" & son & ", AL3:AL" & son & ", AZ3:AZ" & son).Address
If Intersect(Target, Range([COLOR=rgb(132, 53, 52)]alan[/COLOR])) Is Nothing Then Exit Sub
    If Target <> "" Then
        Cells(sat, sut + 2) = WorksheetFunction.EDate(Cells(sat, sut - 5), 12)
    Else: Cells(sat, sut + 2).ClearContents
    End If
[B]End Sub[/B]
 
Oyla 0 Olumsuz oyla
Estağfurullah.
İyi çalışmalar dilerim.

Ancak bir hususu hatırlatayım, verdiğim koddaki WorksheetFunction.... kısmı örneğin 29.02.2016 için 28.02.2017 sonucunu verir.
Yani olmayan tarih oluşturulmaz, zira 29.02.2017 diye bir tarih yok (2017 Şubat ayı 28 gün)
Şayet 29.02.2016 tarihi için 01.03.2017 sonucunu almak istiyorsanız koddaki
WorksheetFunction.EDate(Cells(sat, sut - 5), 12) kısmını aşağıdaki şekilde değiştirin.
DateSerial(Year(Cells(sat, sut - 5)) + 1, Month(Cells(sat, sut - 5)), Day(Cells(sat, sut - 5)))
 
Oyla 0 Olumsuz oyla
Ömer Abi
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
son = [O2].End(xlDown).Row: sat = Target.Row: sut = Target.Column
alan = Range("X3:X" & son & ", AL3:AL" & son & ", AZ3:AZ" & son).Address
If Intersect(Target, Range(alan)) Is Nothing Then Exit Sub
    If Target <> "" Then
        Cells(sat, sut + 2) = DateSerial(Year(Cells(sat, sut - 5)) + 1, Month(Cells(sat, sut - 5)), Day(Cells(sat, sut - 5)))
    Else: Cells(sat, sut + 2).ClearContents
    End If
End Sub

Gerçek dosyada (ki örnek ile aynısı)
3. ve 4. satırlarda sıkıntısız çalışıyor. Ondan sonraki satırlarda makro işlem görmüyor.
 
Oyla 0 Olumsuz oyla
İşlem yapılacak enson satır numarası koddaki son = [O2].End(xlDown).Row kısmı belirliyor.
Anlamı O2'den yukarıdan aşağı doğru ilk boş satırın üstündeki satır.

İsterseniz onun yerine son = Cells(Rows.Count,"O").End(3).Row yazın.
Böylece O sütununda aşağıdan yukarı doğru ilk dolu satır olarak belirlenmiş olur.
 
Oyla 0 Olumsuz oyla
Yanıt için giriş yapmanız veya üye olmanız gerekir.
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst