yan satıra otomatik tarih atacak ama yeni girişte eski tarihler değişmeyecek

[nilseninsaat]

Sayın Hocam Merhaba

Ben bir harcama listesi yapmak istiyorum.
harcamayı girince o anki tarih ve saati yan sütuna yazdırıyorum.
Benim tarih için kullandığım formul: =EĞER(C5="";"";ŞİMDİ())

şimdi sutun sırası şu şekilde:
A: tarih yazılan sütün
B: açıklama sutunu
C: harcama müktarı
D: toplam harcamalar

ikinci harcamayı, alt satıra girdiğimde, bütün eski harcamalar o gün ve saate değişiyor. Ben sabit kalmasını istiyorum, ki hangi gün ne kadar harcamışım bileyim.
Bu konuda sizden destek rica ediyorum. bir kaç makro buldum eskilerden ama hiç biri çalışmadı bende.

Saygılar.

 

[AlpDurmaz]

Tüm yardımlarınız için teşekkürler!

 

[metin80]

anladığım kadarıyla bu şekilde mi istiyorsunuz. eğer böyle bir şey ise formulleri aşağı çekerek çoğaltabilirsiniz

 

[nilseninsaat]

anladığım kadarıyla bu şekilde mi istiyorsunuz. eğer böyle bir şey ise formulleri aşağı çekerek çoğaltabilirsiniz

Metin bey malesef indiremiyorum. altın üye olmak gerekiyormuş. Bana eposta ile iletebilir misiniz lütfen.
nilsen.web@gmail.com

 

[Necdet]

Merhaba,
Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyayalıp deneyiniz.
C sütununa değer girildiğinde A sütununa tarih ve saati yazar, C sütunundaki değer silindiğinde ise siler.
Kod 1. satırın başlık satırı olduğu düşünülerek 1. satırda çalışmaz.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [C:C]) Is Nothing Or Target.Row < 2 Then Exit Sub
    If Target.Value = "" Then
        Target.Offset(0, -2).Value = ""
    Else
        Target.Offset(0, -2).Value = Now
    End If
    
End Sub

 

[nilseninsaat]

Merhaba,
Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyayalıp deneyiniz.
C sütununa değer girildiğinde A sütununa tarih ve saati yazar, C sütunundaki değer silindiğinde ise siler.
Kod 1. satırın başlık satırı olduğu düşünülerek 1. satırda çalışmaz.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [C:C]) Is Nothing Or Target.Row < 2 Then Exit Sub
    If Target.Value = "" Then
        Target.Offset(0, -2).Value = ""
    Else
        Target.Offset(0, -2).Value = Now
    End If
   
End Sub

Sayın Necdet Bey Merhaba
Yolladığınız kodu, bir denem sürümü excel indirerek denedim. Çok güzel çalışıyor. Çok teşekkür ederim.

Bir ekleme yapmak istiyorum.
Her günün en son satırına, bir ertesi gün harcama girdiğimde, bir önceki günün toplam harcamasını E sütününa yazdırmak.
Bunu makro ile mi yapabiliriz yoksa formülle yapılabilir mi?

Desteğiniz için çok teşekkür ederim.
Saygılar,

 

[Necdet]

Merhaba,
Bir kaç satırdan oluşan örnek bir dosya eklerseniz, değişik çözümler üreten arkadaşlar çıkacaktır.

 

[nilseninsaat]

Merhaba,
Bir kaç satırdan oluşan örnek bir dosya eklerseniz, değişik çözümler üreten arkadaşlar çıkacaktır.

bu harcama dosyası ve gün sonuna, ertesi gün harcama girildiğinde, o günün toplamını almasını istiyorum.

 

[Necdet]

Merhaba,

Olması gereken durumu söylememişsiniz, ben de bir yöntem uyguladım, umarım işinize yarar.
Tarih değiştiğinde bir üst satırın fontunu kırmızı ve koyu yapar, veri satırında formülü kaldırır, sonraki satırlarda toplayarak gider.

Eğer veriler üzerinde toplu düzeltme yapmak isterseniz N1 hücresini kontrol amaçlı kullandım.
N1 hücresinde herhangi bir değer varsa kodlar çalışmaz, kodların çalışması için N1 hücresinin boş olması gerekir.
İşinize yarar ve N1 hücresi sizin kullandığınız hücre ise bu değeri başka bir hücreye aktarıp kodda bunu düzeltmelisiniz.

Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp deneyiniz.

Option Explicit

Private Sub Worksheet_Activate()

    With Application
        .ErrorCheckingOptions.UnlockedFormulaCells = False
        .MoveAfterReturnDirection = xlToRight
    End With
    Range("B" & Cells(Rows.Count, "C").End(3).Row + 1).Activate
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  
    If Intersect(Target, [C:C]) Is Nothing Or Target.Row < 2 Then Exit Sub
    
    If [N1] <> "" Then Exit Sub
    
    If Target.Value = "" Then
        Target.Offset(0, -2).Value = ""
    Else
        Target.Offset(0, -2).Value = Now
    End If
    
    If Target.Row = 2 Then
        Target.Offset(0, 1) = Target.Value
    Else
        If Date = CDate(Left(Target.Offset(-1, -2), 10)) Then
            Target.Offset(0, 1).FormulaR1C1 = "=R[-1]C+RC[-1]"
        Else
            With Range("A" & Target.Row - 1 & ":E" & Target.Row - 1).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Color = -16777024
                .TintAndShade = 0
                .Weight = xlThick
            End With
            
            Target.Offset(0, 1) = Target.Value
        End If
    End If
    
End Sub

Private Sub Worksheet_Deactivate()

    With Application
        .ErrorCheckingOptions.UnlockedFormulaCells = True
        .MoveAfterReturnDirection = xlDown
    End With
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Row = 1 Then Exit Sub
    If Target.Column = 4 Then
        Target.Offset(0, 1).Activate
    ElseIf Target.Column > 5 Then
        Range("B" & Target.Row + 1).Activate
    End If
    
End Sub

 

[Necdet]

9 gün geçmiş bir yorum yapılmamış.
Boşuna mı uğraştık ne?