Çözüldü Geçmiş kayıtları oluşturma

[Ömer Çakır]

İyi günler,
Arkadaşlar hali hazırda kullandığım bir excell programı var, 23 farklı dikdörtgen prizmasının içindeki sıvının hacmini hesaplıyorum. Aslında diktörgen prizma dediğim hacimler tam olarak dikdörtgen prizma değil bu sebeple bu bu dikdörtgen prizması vari şeylerin her birinin içindeki sıvının hacmi yüksekliği ile doğrusal artmıyor. Her birinin kendi kalibrasyon tabloları var. Oradan düşey ara fonksiyonu ile değer hesaplatıyorum.
Şimdi bire bir aynısı değil ama basit şekilde anlaşılması için şu şekilde örneklenebilir belki, her bir dikdörtgen prizmasına bir şehir adı veriyorum, Adana ile başladığını varsayalım.
1 Adana
2 Ankara
3 İstanbul
4 İzmir
Şeklinde gidiyor.
Bunların her biri birer satırda
Şimdi a sütunu şehir adları, b sütunu en, c sütunu boy, d sütunu yükseklik, e (sütunu burada hacmi düşey ara ile diğer sayfalardan bulup çektiriyorum, f sütunu ise yoğunluk, g sütunu ağırlık

Burada girdi değişkenler b,c,d ve f sütunları.
Yapmaya çalıştığım şey şu.
Herhangi bir girdi değişken değiştiğinde, mesela B2 (B2, C2, D2 VE/VEYA F2) hücre değeri değiştiğinde, (Burada 2.satır malum yukarda Ankara oluyor)
AnkaraGecmis adlı başka bir sayfaya bu değerleri sırasıyla kaydedecek değerin değiştiği tarih ve saat değeri ile beraber, aşağıdaki gibi

A B C D E F G H
2 Ankara 3,7 4,2 5,4 83,916 1,020 85,59432 21.10.2022 03:30:00

İlk Sayfanın adı “Degerler”, ikinci sayfanın adı “AnkaraGecmis” vs şeklinde sayfalar devam edecek
23 farklı dikdörtgen prizması için 23 adet geçmiş sayfası olacak.
Her bir değer değiştiğinde mesela C4 değeri değiştiğinde; 4 burada İstanbul oluyor, C sütunu Boy oluyor.
IstanbulGecmis sayfasına yeni bir satır şeklinde mesala aşağıdaki gibi bunları kaydedecek.
3,7 4,2 5,4 83,916 1,020 85,59432 21.10.2022 03:30:00(değişikliğin yapıldığı tarih ve saat)
Daha sonra ben bu değerlerin değişme sıklığından her bir değişiklik arasındaki değişim hızını hesaplamaya çalışacağım, sanırım o kısmı ben halledebilirim.

Sizden ricam en azından 2 – 3 değişik satır için bunu örneklemeniz, sanırım devamını ben yapabilirim 23 farklı satır için.
Yardımınız rica lütfen

 

[Korhan Ayhan]

Merhaba,

Girdi değişkenlerini elle mi yazacaksınız?

Birde her girdi değişiminde mi geçmiş kaydı yapilacak?

Yani 2. Satır için orneklersek;

En değişti aktar
Boy değişti aktar
Yükseklik değişti aktar

Şeklinde 3 satırlık bir geçmiş arşivimi oluşacak?

 

[Ömer Çakır]

Merhaba,

Girdi değişkenlerini elle mi yazacaksınız?

Birde her girdi değişiminde mi geçmiş kaydı yapilacak?

Yani 2. Satır için orneklersek;

En değişti aktar
Boy değişti aktar
Yükseklik değişti aktar

Şeklinde 3 satırlık bir geçmiş arşivimi oluşacak?

Merhaba,

Girdi değişkenleri elle girilecek, bütün girdiler ilk sayfaya (İlk Sayfanın adı “Degerler”) yapılacak.
Örneğin,
Ankara sabitinin herhangibir değişkeni değiştiğinde Ankara sabitinin o sefer yapılan yeni girişle beraber eski girişeride dahil tüm girdilerini ve sonuçlarını Ankaragecmis sayfasında bir satıra yazacak
Sonraki sefer eğer ankara sabitinin örneğin boyu değişti bu sefer bu girdilerle sonuçları yine aynı şekilde Ankaragecmis sayfasına daha önce yazdığı satırın altına yazacak

 

[Korhan Ayhan]

Tek bir geçmiş sayfasına aktarım olsa daha kolay takibi olmaz mı?

Zaten A sütununda prizma adları olacağı için filtreleyerek takip edilebilir gibi düşünüyorum.

 

[Ömer Çakır]

Tek bir geçmiş sayfasına aktarım olsa daha kolay takibi olmaz mı?

Zaten A sütununda prizma adları olacağı için filtreleyerek takip edilebilir gibi düşünüyorum.

Mantıklı, filtreleme ile dediğiniz şekilde kullanılabilir. Hatta daha iyi olur geçmiş sayfaları arasında kaybolmam. Tüm geçmişe tek sayfada erişebilirim.

 

[Korhan Ayhan]

Ben sayfaya arşiv ismini verdim.

İlk satırlarda başlık olduğunu varsaydım.

Aşağıdaki kodu "Degerler" isimli sayfanızın kod bölümüne uygulayınız. B-C-D-F sütunlarındaki hücrelerde değişiklik yaptıkça veriler aktarılacaktır.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet
    
    If Intersect(Target, Range("B2:D1048576,F2:F1048576")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    
    If Target <> "" Then
        Set Sh = Sheets("Arşiv")
        If WorksheetFunction.CountIfs(Sh.Range("A:A"), Cells(Target.Row, "A"), _
                                      Sh.Range("B:B"), Cells(Target.Row, "B"), _
                                      Sh.Range("C:C"), Cells(Target.Row, "C"), _
                                      Sh.Range("D:D"), Cells(Target.Row, "D"), _
                                      Sh.Range("E:E"), Cells(Target.Row, "E"), _
                                      Sh.Range("F:F"), Cells(Target.Row, "F"), _
                                      Sh.Range("G:G"), Cells(Target.Row, "G")) = 0 Then
            Range("A" & Target.Row & ":G" & Target.Row).Copy Sh.Cells(1048576, "A").End(3)(2, 1)
            Sh.Cells(1048576, "H").End(3)(2, 1) = Now
        Else
            MsgBox "Bu kayıt daha önce arşiv sayfasına aktarılmıştır.", vbCritical
        End If
        Set Sh = Nothing
    End If
End Sub

 

[Korhan Ayhan]

Ek olarak sayfaya "Geçmiş" adını vermek istedim. Excel kabul etmedi. Araştırınca aşağıdaki bilgiye ulaştım.

Excel sayfa adı değiştirme

 

[Ömer Çakır]

Ek olarak sayfaya "Geçmiş" adını vermek istedim. Excel kabul etmedi. Araştırınca aşağıdaki bilgiye ulaştım.

Excel sayfa adı değiştirme

Ekli dosyayı görüntüle 240227

Ek olarak sayfaya "Geçmiş" adını vermek istedim. Excel kabul etmedi. Araştırınca aşağıdaki bilgiye ulaştım.

Excel sayfa adı değiştirme

Ekli dosyayı görüntüle 240227

Teşekkür ederim Korhan Bey, kod çalıştı. Elinize, emeğine sağlık.

 

[Ömer Çakır]

Ek olarak sayfaya "Geçmiş" adını vermek istedim. Excel kabul etmedi. Araştırınca aşağıdaki bilgiye ulaştım.

Excel sayfa adı değiştirme

Ekli dosyayı görüntüle 240227

Korhan Bey tekrar iyi günler,

Kodları dosyama uygulamaya çalıştım, kısmen bazı değerleri Arşiv kısmına kopyalayamadım. Dosyam ekte, mümkünse bakabilir misiniz lütfen. Arşiv kısmında I, J, K, L ve M sütunlarındaki değerleri "BALLAST CALCULATION" adlı ilk sayfadan değer olarak aldıramadım. Malum BALLAST CALCULATION sayfasında o hücrelerin değerleriher zaman değişebilir çünkü girdiler değişiyor, ama Arşiv de o değerlerin değişmemesi gerekiyor.

Yine BALLAST CALCULATION kısmındaki P sütunu içeriği metinleri ilave yorumlar olacak orada Arşiv de Q sütünuna alamadım.

Bir de kendim yapmayı umuyordum ama malum önceden ben her satır için farklı bir geçmiş dosyası düşünüyordum. Sizin önerinizle geçmişin hepsini Arşiv adında tek sayfaya topluyoruz. Rate yani ivme hız gibi düşünün, ynı isimli dikdörtgen prizmaya 2.kez değer girdiğimde ilk girdiğim değerle son girdiğim değer arasındaki zamanı ve Volume (hacim) değeri farklarını hesaplayıp bana saatlik bir oran vermeli. Sanırım bu makrolarla daha kolay yapılabilir, mümkünse bakabilir misiniz lütfen.

Birde rate hesabının düzgün hesaplanabilmesi için E F G H sütunlarının değeri değişse bile Arşiv kısmına kayıt yapmaması gerekiyor sanırım, bence bunun için en mantıklı yol, D sütununa değer girildiğinde Arşiv e alsın o satırı, ayrıca sanırım D sütunundaki hücre güncellenmeden E F G H sütunlarına da değer girmesi önlensin, böylece. Bir satırda değer girilebilmesi için önce D sütunu değeri girilsin sonra E F G H sütunlarına değer girilebilisin ki arşive alınan bu yeni girdi satırı ile bir önceki Sabit in örneğin W.B.T. NO:1P sabitinin volume leri arasındaki fark sağlıklı hesaplanabilsin

Rate hesabını formülle örnekledim Arşiv sekmesinde son satırda

 

[Haluk]

Ek olarak sayfaya "Geçmiş" adını vermek istedim. Excel kabul etmedi. Araştırınca aşağıdaki bilgiye ulaştım.

İngilizce versiyonlarda da aynı nedenle "History" kullanılamıyor.

.

 

[Korhan Ayhan]

Kodu sadece D sütununa veri girişnde aktaracak şekilde revize ettim. Ayrıca verileri değer ve biçim olarak aktarıyor. Gerisini size bırakıyorum.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet
    
    If Intersect(Target, Range("D7:D30")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    
    If Target <> "" Then
        Set Sh = Sheets("Arşiv")
        If WorksheetFunction.CountIfs(Sh.Range("A:A"), Cells(Target.Row, "A"), _
                                      Sh.Range("B:B"), Cells(Target.Row, "B"), _
                                      Sh.Range("C:C"), Cells(Target.Row, "C"), _
                                      Sh.Range("D:D"), Cells(Target.Row, "D"), _
                                      Sh.Range("E:E"), Cells(Target.Row, "E"), _
                                      Sh.Range("F:F"), Cells(Target.Row, "F"), _
                                      Sh.Range("G:G"), Cells(Target.Row, "G"), _
                                      Sh.Range("H:H"), Cells(Target.Row, "H"), _
                                      Sh.Range("I:I"), Cells(Target.Row, "I"), _
                                      Sh.Range("J:J"), Cells(Target.Row, "J"), _
                                      Sh.Range("K:K"), Cells(Target.Row, "K"), _
                                      Sh.Range("L:L"), Cells(Target.Row, "L"), _
                                      Sh.Range("M:M"), Cells(Target.Row, "M"), _
                                      Sh.Range("N:N"), Cells(Target.Row, "N"), _
                                      Sh.Range("O:O"), Cells(Target.Row, "O")) = 0 Then
            Application.ScreenUpdating = False
            Range("A" & Target.Row & ":O" & Target.Row).Copy
            Sh.Cells(1048576, "A").End(3)(2, 1).PasteSpecial xlPasteValues
            Sh.Cells(1048576, "A").End(3)(1, 1).PasteSpecial xlPasteFormats
            Sh.Cells(1048576, "P").End(3)(2, 1) = Now
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
        Else
            MsgBox "Bu kayıt daha önce arşiv sayfasına aktarılmıştır.", vbCritical
        End If
        Set Sh = Nothing
    End If
End Sub

 

[Ömer Çakır]

Kodu sadece D sütununa veri girişnde aktaracak şekilde revize ettim. Ayrıca verileri değer ve biçim olarak aktarıyor. Gerisini size bırakıyorum.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet
  
    If Intersect(Target, Range("D7:D30")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
  
    If Target <> "" Then
        Set Sh = Sheets("Arşiv")
        If WorksheetFunction.CountIfs(Sh.Range("A:A"), Cells(Target.Row, "A"), _
                                      Sh.Range("B:B"), Cells(Target.Row, "B"), _
                                      Sh.Range("C:C"), Cells(Target.Row, "C"), _
                                      Sh.Range("D:D"), Cells(Target.Row, "D"), _
                                      Sh.Range("E:E"), Cells(Target.Row, "E"), _
                                      Sh.Range("F:F"), Cells(Target.Row, "F"), _
                                      Sh.Range("G:G"), Cells(Target.Row, "G"), _
                                      Sh.Range("H:H"), Cells(Target.Row, "H"), _
                                      Sh.Range("I:I"), Cells(Target.Row, "I"), _
                                      Sh.Range("J:J"), Cells(Target.Row, "J"), _
                                      Sh.Range("K:K"), Cells(Target.Row, "K"), _
                                      Sh.Range("L:L"), Cells(Target.Row, "L"), _
                                      Sh.Range("M:M"), Cells(Target.Row, "M"), _
                                      Sh.Range("N:N"), Cells(Target.Row, "N"), _
                                      Sh.Range("O:O"), Cells(Target.Row, "O")) = 0 Then
            Application.ScreenUpdating = False
            Range("A" & Target.Row & ":O" & Target.Row).Copy
            Sh.Cells(1048576, "A").End(3)(2, 1).PasteSpecial 7
            Sh.Cells(1048576, "A").End(3)(1, 1).PasteSpecial 11
            Sh.Cells(1048576, "P").End(3)(2, 1) = Now
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
        Else
            MsgBox "Bu kayıt daha önce arşiv sayfasına aktarılmıştır.", vbCritical
        End If
        Set Sh = Nothing
    End If
End Sub

Korhan Bey geri dönüşünüz için teşekkür ederim.
Yukarıdaki şekilde kodları düzenledim ama Arşiv sayfasına yazdığı I, J, K, L, M, N sutunlarını doğru değerler olarak kopyalamıyor "BALLAST CALCULATION" sayfasından.

 

[Korhan Ayhan]

Kod A:O sütun aralığını Arşiv sayfasında aynı aralığa değer ve biçim olarak yapıştırıyor. Sorun nerede?

 

[Ömer Çakır]

Kod A:O sütun aralığını Arşiv sayfasında aynı aralığa değer ve biçim olarak yapıştırıyor. Sorun nerede?

Kırmızı ile işaretlediğim hücreler aynı değerlere sahip olmalı ama değiller

 

[Korhan Ayhan]

Sorunu anladım. Yapıştırma seçeneklerinin yerini değiştirince sorun düzeldi.

 

[Ömer Çakır]

Sorunu anladım. Yapıştırma seçeneklerinin yerini değiştirince sorun düzeldi.

Teşekkür ederim Korhan Bey, evet sorun düzeldi. Şuan tanklardaki değerlerin geçmişi güzel şekilde kayıt altına alınabiliyor.

Geriye bir tek Arşiv sayfasında O sütununda rate yani oran hesabı yaptırmak kalıyor. Acaba makro ile o kısım formule edilebilir mi?

 

[Korhan Ayhan]

Diyelim ki arşiv sayfasında aynı tankla ilgili 10 satır var. Bu durumda kurgu nasıl olmalı?

 

[Ömer Çakır]

Diyelim ki arşiv sayfasında aynı tankla ilgili 10 satır var. Bu durumda kurgu nasıl olmalı?

Arşiv sayfasında D sütunu "Last sounding" değeri o tanka işlem başlamadan girilmiş olacak. Bu durumda

Arşiv sayfasındaki her satır, o satır hangi tankla ilgili ise örneğin yukarki son resimde
W.B.T. NO:5P son girdisi 5.satırda, Burada O5 hücresine rate hesaplatabilmek için
W.B.T. NO:5P için sondan bir önceki kayıda gidecek, yukarki resimde W.B.T. NO:5P için sondan bir önceki kayıt 4. satırda

 

[Korhan Ayhan]

W.B.T. NP:5P için10 satırlık bir veri olsaydı hesaplama nasıl olmalıydı?

 

[Ömer Çakır]

W.B.T. NP:5P için10 satırlık bir veri olsaydı hesaplama nasıl olmalıydı?

W.B.T. NP:5P için rate hesabı yaparken en son girilen değerin girildiği saat resimde görülen ekran çıktısında D18 ile W.B.T. NP:5P için sondan bir önceki D17 arasındaki zaman farkı bulunmalı
resimde bu zaman farkı D18 eksi D17
Sonra yine W.B.T. NP:5P için en son değerin girildiği saatteki M3 volume yani hacim değeri L18 ile aynı tank W.B.T. NP:5P için bir önceki L sütunu değeri L17 alınmalı ve arasındaki fark bulunmalı

Ve Rate hesabı şu formülle hesaplanmalı =(0,0416666666642413*(L18-L17))/(D18-D17)

Herhangi bir tank için rate hesaplarken ilk rate hesapladığı değer istisna geçilmeli boş olmalı çünkü ilkin bir öncesi değerler yok.
ikinci değerler geldiğinde 2.değerde gelen değerler ile bundan önceki yani 1.değerde bulunan D ve L sütunundaki değerler ile birinci ve ikinci girdiler arasındaki saatlik hacim değişikliği hesaplanmalı.

W.B.T. NP:5P için örnek değerler içeren resim ekte burada W.B.T. NP:5P için ilk rate verilen hücreyi kırmızı işaretledim.

Dosyanın son hali ektedir.