A1 hücresindeki veri her değiştiğinde tüm eski ve yeni verileri b sütununda kaydetmek

[voodoograph]

Dinamik bir tablom var Sayfa 1 de. SQL den veri çekiyor.

A1 hücresindeki veri her değiştiğinde değişen veriyi başka hücreye yazdırmak istiyorum.

Örnek
a1: 10 du. B1 e yazdı.
a1: 20 oldu, b2 ye yazdı.
a1: 40 oldu, b3 e yazdı. gibi.

Eğer bu olursa bir de tarih şartı koymak isterim.
Örneğin 01.01.2016 da a1 verisi 20-30 kere değişse bile sadece 01.01.2016, 23:59 daki veriyi b1 e son kez yazacak. 02.01.2016, 00:01 den sonra A1 i b2 ye yazmaya başlayacak. Sonra gün gün b3 b4 b5 diye devam edecek.

 

[Necdet]

Merhaba,

Birinci satır başlık olarak kabul ettim.
Örneğin
A1 =Değişin Değer
B1 = Liste
C1 = Tarih

Bu durumda A2 değiştikçe kodlar çalışacaktır.

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

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [A2]) Is Nothing Then Exit Sub
    
    Dim i As Long
    
    If Date > Range("C2") Then
        Range("C2") = Date
        Range("B2:B" & Cells(Rows.Count, "B").End(3).Row).ClearContents
    End If
    
    i = Cells(Rows.Count, "B").End(3).Row + 1
    Range("B" & i) = Range("A2")
    
End Sub

 

[voodoograph]

Çok teşekkür ederim. Sanırım oldu. Biraz daha geliştireceğim.

 

[voodoograph]

Kodla uğraşırken bir eksiklik buldum.

O kodları kullandığımda sorun şu ki tarih değiştiğinde önceki tarihte girilen eski veriler siliniyor sütundan Onu nasıl çözeriz. Yeni tarihi alta ekleyebilir mi ki?.

 

[sirkülasyon]

Necdet Abi;
2. mesajda yer alan kodda değer değiştikçe tarih sadece C2 hücresinde atıyor.
Her değişimde ilgili satıra atabilir mi?

 

[voodoograph]

SİRKÜLASYON ... o sorunu şöyle çözdüm ancak ilk değer tarihi değiştirdiğimde nedense değişip duruyor.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A2]) Is Nothing Then Exit Sub

Dim i As Long
Dim y As Long

If Date > Range("C2") Then
Range("C2") = Now
Range("B" & Cells(Rows.Count, "B").End(3).Row).ClearContents
Range("c" & Cells(Rows.Count, "c").End(3).Row).ClearContents
End If

i = Cells(Rows.Count, "B").End(3).Row + 1
Range("B" & i) = Range("A2")
y = Cells(Rows.Count, "C").End(3).Row + 1
Range("C" & y) = Now
End Sub

DEĞİŞEN DEĞER
12 1 25.1.16 16:33
2 24.1.16 16:31
3 24.1.16 16:31
4 24.1.16 16:31
5 24.1.16 16:31
6 24.1.16 16:31
7 24.1.16 16:31
8 24.1.16 16:31
9 24.1.16 16:31
10 24.1.16 16:31
12 25.1.16 16:33

 

[voodoograph]

Çözdüm sanırım.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A2]) Is Nothing Then Exit Sub

Dim i As Long
Dim y As Long
Dim x As String
x = Format(Now, "dd/MM/yyyy hh:mm:ss")
If Date > Range("C2") Then
Range("C2") = x
Range("B2:B" & Cells(Rows.Count, "B").End(3).Row).ClearContents
Range("C" & Cells(Rows.Count, "C").End(3).Row).ClearContents
End If

i = Cells(Rows.Count, "B").End(3).Row + 1
Range("B" & i) = Range("A2")
y = Cells(Rows.Count, "C").End(3).Row + 1
Range("C" & y) = Now
End Sub

DEĞİŞEN DEĞER Tarih
9 1 27.01.2016 17:54
2 27.01.2016 17:54
3 27.01.2016 17:54
5 27.01.2016 17:54
7 27.01.2016 17:54
8 24.01.2016 17:54
9 24.01.2016 17:54

 

[sirkülasyon]

Teşekkürler

 

[Necdet]

Eğer bu olursa bir de tarih şartı koymak isterim.
Örneğin 01.01.2016 da a1 verisi 20-30 kere değişse bile sadece 01.01.2016, 23:59 daki veriyi b1 e son kez yazacak. 02.01.2016, 00:01 den sonra A1 i b2 ye yazmaya başlayacak. Sonra gün gün b3 b4 b5 diye devam edecek.

Tarih değiştiğinde B2 ye yazmaya başlayacak demek, verilerin silinmesi anlamına gelmiyor mu?

 

[voodoograph]

Necdet Bey,

Hayır, silinmeyecek. Her değişikliği bir veritabanı gibi koruyacak.

Bu arada aşağıdaki kod neden sadece 2.satırdan itibaren başlıyor. 5.satırdan itibaren kayıt yaptıramadım bir türlü. Veri ve tarih 5.satırdan itibaren başlamadı gitti.

Sistem saatini ileriye, geriye çektiğimde liste başındaki tarih ile aynı oluyor nedense...

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A2]) Is Nothing Then Exit Sub

Dim i As Long
Dim y As Long
Dim x As String
x = Format(Now, "dd/MM/yyyy hh:mm:ss")
If Date > Range("C2") Then
Range("C2") = x
Range("B2:B" & Cells(Rows.Count, "B").End(3).Row).ClearContents
Range("C" & Cells(Rows.Count, "C").End(3).Row).ClearContents
End If

i = Cells(Rows.Count, "B").End(3).Row + 1
Range("B" & i) = Range("A2")
y = Cells(Rows.Count, "C").End(3).Row + 1
Range("C" & y) = Now
End Sub