• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Günlük Veri Toplamını Tarihe dayalı Saklamak

Katılım
9 Ocak 2011
Mesajlar
354
Excel Vers. ve Dili
2007 Türkçe
Excel dosyasını açtığımda Ana sayfada (Sayfa1) o günki günlük verilerimin toplamını alıyorum.
ama ertesi günü dosyayı açtığımda ancak o günki verilere ulaşabiliyorum.
Günlük olarak rapor anlamında kullanmak için Başka bir sayfada önceki günlerdeki verileride
geriye dönük bakabilmek için hergünki toplamı kendi tarihinin karşısına kalıcı olarak
otomatik olarak nasıl yazdıarabilirim.

Yani dosyayı açtım ogünki değerlerden verileri aldı hesaplamaları yaptı toplam değeri
bulup bana (Sayfa1 B98) verdi bu değer o günki değer budeğeri diyelimki (3.sayfaya)
Önceden hazırladığım veya kendi oluşturacağı tarihin karşısına yazacak işi bitecek.
Hergün veya 2-3 günde bir dosyayı çalıştırdığımda (3.sayfaya) verileri dikey olarak işleyecek.
Takip edilecek veri sadece (Sayfa1 B98) deki veri olacak belli bir bölüm veya sayfadaki değişiklikler değil.

Elle tek tek girmek sıkıntı vermesin diye.

Örnek : Tarihli veri güncelleme.xls
 
Sayfanın kod bölümü:
Kod:
Dim Eski_Değer
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Satır = WorksheetFunction.CountA(Sheets("YEDEK").Range("A:A")) + 1
    Sheets("YEDEK").Cells(Satır, 1) = Satır - 1
    Sheets("YEDEK").Cells(Satır, 2) = Date
    Sheets("YEDEK").Cells(Satır, 3) = Time
    Sheets("YEDEK").Cells(Satır, 4) = Application.UserName
    Sheets("YEDEK").Cells(Satır, 5) = ActiveSheet.Name & "!" & Target.Address(1, 1)
    Sheets("YEDEK").Cells(Satır, 6) = IIf(Eski_Değer = "", "Boş Hücre", Eski_Değer)
    Sheets("YEDEK").Cells(Satır, 7) = IIf(Target = "", "Değer Silindi !", Target)
    Sheets("YEDEK").Cells.EntireColumn.AutoFit
End Sub

Private Sub Worksheet_Deactivate()

End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Eski_Değer = Target
End Sub

Modül:
Kod:
Sub GİZLE()
    Sheets("YEDEK").Visible = 2
End Sub
 
Sub GÖSTER()
    Sheets("YEDEK").Visible = -1
End Sub

ThisWorkbook:
Kod:
Private Sub Workbook_Activate()
    Sheets("YEDEK").Visible = 2
    Application.OnKey "{F11}", "GÖSTER"
    Application.OnKey "{F12}", "GİZLE"
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "{F11}", ""
    Application.OnKey "{F12}", ""
End Sub
 
Private Sub Workbook_Deactivate()
    Application.OnKey "{F11}", ""
    Application.OnKey "{F12}", ""
End Sub
 
Private Sub Workbook_Open()
    Sheets("YEDEK").Visible = 2
    Application.OnKey "{F11}", "GÖSTER"
    Application.OnKey "{F12}", "GİZLE"
End Sub

Şöyle bir Kod buldum belki üzerinde değişiklik yapılarak veya geliştirilerek kullanabilirmiyim acaba?
Yukarıdaki kod Tüm sayfadaki değişiklikler için yapılmış.
Ben ise Sadece 1.Hücredeki değişiklikleri takip ederek yedeklemek için kullanmak istiyorum.

Mesela (Sayfa1 B98)

Bu işlemi yapabilmek için Kodda ne gibi değişiklik yapmam lazım bilgisi olan varmı acaba?
Teşekkürler
 
Merhaba;
2. sayfanın işlevini anlayamadım ama eki yinede inceleyin.
İyi çalışmalar.
Not: Kodlar alıntıdır.
 

Ekli dosyalar

Merhaba;
2. sayfanın işlevini anlayamadım ama eki yinede inceleyin.
İyi çalışmalar.
Not: Kodlar alıntıdır.

Siz benim istediğimi anlayamamışssınız yada ben anlatamadım ekteki kod istediğimi yapıyor ama
komple sayfa değişikliğini baz alıyor halbuki ben sadece bir hücredeki değişikliği aktarmak istiyorum.
Genede ekte yeni dosyayı koydum tarihi kendisi yazacak karşısınada 1.sayfadaki belirttiğim hücredeki
veriyi hergün alt alta tarihin karşısına işleyecek.
 

Ekli dosyalar

Son düzenleme:
Ekteki dosyayı incelermisiniz dosya açılıp sayfa iki açıldığında o gün ilk açılıyorsa sayfa2 deki b3 hücresini sayfa1 e yanınına tarih ekleyerek atıyor.
 

Ekli dosyalar

Ekteki dosyayı incelermisiniz dosya açılıp sayfa iki açıldığında o gün ilk açılıyorsa sayfa2 deki b3 hücresini sayfa1 e yanınına tarih ekleyerek atıyor.

Hüseyin Hocam,

Hazırladığınız sayfayı kendime uyarladım bilemiyorum oldumu
Kodu girmekte biraz zorlandım.Daha önceki Kodun altına bu şekilde girebildim.
Bilemiyorum bu şekilde altına yazınca çalışırmı?
Yalnız Bu Kodu Üstteki Bölümde Solda :Worksheet Sağda : Activate olacak şekilde girdim.

Kodu kendime göre Değiştirdiğim yerler Kırmızı olarak işaretli doğrumu bilmiyorum.

Kod:
Function AHK(aranan)
Set S1 = Sheets("Sayfa2")
a = S1.Range("A1:P700").Find(What:=aranan, LookAt:=xlWhole).Row
b = S1.Range("A1:P700").Find(What:=aranan, LookAt:=xlWhole).Column
AHK = S1.Cells(a, b + 3).Value
End Function
-----------------------------------------------------------------------
Private Sub Worksheet_Activate()
aaa = WorksheetFunction.CountIf(Sheets("Sayfa[COLOR="Red"]3[/COLOR]").Range("A:A"), Date)
If aaa = 0 Then
Sonsat = Sheets("Sayfa[COLOR="#ff0000"]1[/COLOR]").Range("A65536").End(3).Row + 1
Sheets("Sayfa[COLOR="#ff0000"]3[/COLOR]").Cells(Sonsat, 1).Value = Date
Sheets("Sayfa[COLOR="#ff0000"]3[/COLOR]").Cells(Sonsat, 2).Value = Sheets("Sayfa[COLOR="#ff0000"]1[/COLOR]").Range("[COLOR="#ff0000"]B98[/COLOR]").Value
End If
End Sub

Benim Değeri alacağım Sayfa (Sayfa1 B98) Yazılacak Sayfa (Sayfa3) Dikey olarak Baştan aşağıya doğru.
Sizinkinde Değeri (S2 den alıp S1 e yazmış).
Önce Girmedi zannettim tekrar tekrar bişeyler denedim karıştı zira 106.Satıra işlemiş önce görmemişim.
Belkide başka bir kod denemem oraya yazmıştır o zamanda sizin kodu çalıştıramamışım demektir.
Ama 106.Satıra ilk yazılan değerden sonra kaç defa açtım kapadım değer değişmesine rağmen hep ilk değer kaldı.
Altına yeni değerleri yazmadı. Bilemiyorum Kod çalışıyormu.
Acaba Günde bir defamı işliyor bir daha değer değişsede işlemiyormu bilemedim.

Bu Kodu kaç kere dosyayı çalıştırırsak hep işlemesi mümkünmü?
Eğer Mümkünse Tarih Bölümü (25.02.2011 Cuma 14:25) Şeklinde olabilirmi.
Karşısına gene aynı şekilde Değeri yazacak. (Üstten 2.Mesajdaki 1.Kodda olduğu gibi)

Biraz uzun oldu kusura bakmayın Yardımlarınız için çok Teşekkürler

NOT : Evet şimdi girdiği değeri sildim sayfayı kaydedip çıktım tekrar girdiğimde son değeri yazdı.
Bu demektirki kod çalışıyor.
Ama niye 106. satırdan başladı ve sadece bir kere.
Bunu günlük çoğaltmak ve tarihi uzatmak mümkünmü üstte yazmıştım.

Teşekkürler
 
Son düzenleme:
Slm .


Sıradan gidelim..

1= formulu module değil Sayfa3'ün altında bulunan yere yerleştirin.Vb kısmında.
2= Kod sadece günlük çalışır sabah dosyayı açtınız sayfa 3 tıklatınız o gün verisini yazar ve birdaha aynı gün veri atmaz.
3=106 satıra yazması Sonsat = Sheets("Sayfa1").Range("A65536").End(3).Row + 1 formulunde Sayfa1 Sayfa3 olacak. Sayfa birde 105 satıra kadar veri olduğu için sayfa 3 de 106 yazmıştır.
dosya yazarken en son boş satırı seçiyor.
4= Sheets("Sayfa3").Cells(Sonsat, 1).Value = Date formulunu
Sheets("Sayfa3").Cells(Sonsat, 1).Value = Format(Date,"dd.mm.yyyy dddd hh:mm") yaparsanız saatide alabilirsiniz.

5= istediğiniz gibi yapılabilir her an kaydetmesi. her girişi ayrı satıramı yazıcak yoksa aynı satıramı onu bildirirseniz değiştirmeye çalışırım.
 
Slm .


Sıradan gidelim..

1= formulu module değil Sayfa3'ün altında bulunan yere yerleştirin.Vb kısmında.
2= Kod sadece günlük çalışır sabah dosyayı açtınız sayfa 3 tıklatınız o gün verisini yazar ve birdaha aynı gün veri atmaz.
3=106 satıra yazması Sonsat = Sheets("Sayfa1").Range("A65536").End(3).Row + 1 formulunde Sayfa1 Sayfa3 olacak. Sayfa birde 105 satıra kadar veri olduğu için sayfa 3 de 106 yazmıştır.
dosya yazarken en son boş satırı seçiyor.
4= Sheets("Sayfa3").Cells(Sonsat, 1).Value = Date formulunu
Sheets("Sayfa3").Cells(Sonsat, 1).Value = Format(Date,"dd.mm.yyyy dddd hh:mm") yaparsanız saatide alabilirsiniz.

5= istediğiniz gibi yapılabilir her an kaydetmesi. her girişi ayrı satıramı yazıcak yoksa aynı satıramı onu bildirirseniz değiştirmeye çalışırım.

Teşekkürler yardım için

Kod:
Private Sub Worksheet_Activate()
aaa = WorksheetFunction.CountIf(Sheets("Sayfa3").Range("A:A"), Date)
If aaa = 0 Then
Sonsat = Sheets("Sayfa3").Range("A65536").End(3).Row + 1
Sheets("Sayfa3").Cells(Sonsat, 1).Value = Format(Date, "dd.mm.yyyy dddd hh:mm")
Sheets("Sayfa3").Cells(Sonsat, 2).Value = Sheets("Sayfa1").Range("B98").Value
End If
End Sub


1= Sayfa1 altına yerleştirdim test ettim çalıştı genede veri S3 e yazılacağı içinmi S3 e yazmalıyım.
Genede söylediğiniz gibi Sayfa3 altına yazdım. Sayfa1 den kaldırdım.
2= Zaten testlerimde de 1.kere yazdı ver,y, silip kaydedip çıkınca tekrar açınca yazıyor.
3= Evet söylediğiniz gibi orayı Sayfa3 yaptım sayfayı temizledim kaydedip çıktım tekrar girdim Bu sefer 2.Satıra yazdı veriyi.
4= Tarih gün saat formülünü dediğiniz gibi değiştirdim Saat 00:00 diğerleri doğru oldu.
5= Evet nasıl oldu bilmiyorum şimdi sayfaya herbakışımda alt alta yazıyor(Sayfalar arası gezerken bile).
Biraz fazla oldu gibi. Veri değişirse yaz gibi bir seçenek olabilirmi.?
Sonsat = Sheets("Sayfa3") değiştirmek etkili olmuş olabilir.
ancak saat hep 00:00

Teşekkürler
 
Son düzenleme:
Dosyada arama yaptırıken tarihe bak demiştik şimdi tarih formatı değiştiği için dosyaya her geçişte kaydediyor. sizin istediğiniz her güne 1 satır olsun ve enson çıkış yaparken değerini ve saatini yazssın . yoksa her açılışta değeri ve tarihi altalta yazsın tarih 1 taneden fazla olabilir yanında saatleridemi olsun.
 
Dosyada arama yaptırıken tarihe bak demiştik şimdi tarih formatı değiştiği için dosyaya her geçişte kaydediyor. sizin istediğiniz her güne 1 satır olsun ve enson çıkış yaparken değerini ve saatini yazssın . yoksa her açılışta değeri ve tarihi altalta yazsın tarih 1 taneden fazla olabilir yanında saatleridemi olsun.

Sadece veri değişirse yazsın olursa iyi olur. Böyle iyi oluyor Netten verileri güncellediğimde aynıysa yazmayacak veri değişirse yazacak.
Aynı Tarihte birkaç tane olabilir iyi de olur.

Birde Saat niye 00:00 anlayamadım saati yazmıyor.

Teşekkürler sizi yoruyorum.
 
Sadece veri değişirse yazsın olursa iyi olur. Böyle iyi oluyor Netten verileri güncellediğimde aynıysa yazmayacak veri değişirse yazacak.
Aynı Tarihte birkaç tane olabilir iyi de olur.

Birde Saat niye 00:00 anlayamadım saati yazmıyor.

Teşekkürler sizi yoruyorum.

Evet sanırım sona ulaştık.aşağıaki kodları Thisworkbook altına kopyalayın. artık her dosyayı kaydettiğinizde tutar aynı ise işlem yapmayacak ama farklı ise 1 alt satıra yeni saat ve atrihi yazıcak.


Kod:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sonsat = Sheets("Sayfa3").Range("A65536").End(3).Row + 1
If Sheets("Sayfa3").Cells(Sonsat - 1, 2).Value = Sheets("Sayfa1").Range("B98").Value Then
Else
Sheets("Sayfa3").Cells(Sonsat, 1).Value = Format(Date, "DD.MM.YYYY DDDD") & " " & Format(Time, "hh:mm")
Sheets("Sayfa3").Cells(Sonsat, 2).Value = Sheets("Sayfa1").Range("B98").Value
End If
End Sub
 
Evet sanırım sona ulaştık.aşağıaki kodları Thisworkbook altına kopyalayın. artık her dosyayı kaydettiğinizde tutar aynı ise işlem yapmayacak ama farklı ise 1 alt satıra yeni saat ve atrihi yazıcak.


Kod:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sonsat = Sheets("Sayfa3").Range("A65536").End(3).Row + 1
If Sheets("Sayfa3").Cells(Sonsat - 1, 2).Value = Sheets("Sayfa1").Range("B98").Value Then
Else
Sheets("Sayfa3").Cells(Sonsat, 1).Value = Format(Date, "DD.MM.YYYY DDDD") & " " & Format(Time, "hh:mm")
Sheets("Sayfa3").Cells(Sonsat, 2).Value = Sheets("Sayfa1").Range("B98").Value
End If
End Sub

Evet Bu sefer oldu heralde ellerinize sağlık.
Tüm Yardımlarınız için Teşekkür ederim Pazartesi gene son Cevabı verecem
Zira Banka verileri silindi güncelleme yapamıyorum.
Ayrıca Saat gözüküyor artık ama Son Verileri göremiyorum.

Sizi Yordum Teşekkür ediyorum.

SON NOT: Başka bir hücre için değerini değiştirerek denedim çok güzel çalışıyor

Bu konu bitmiştir. İnanıyorum birçok kişinin işine yarayacaktır.
Hüseyin Hocama emekleri için Çok Teşekkürler.
 
Son düzenleme:
Geri
Üst