• DİKKAT

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

Veri Değişince Açıklama Notu Yaz

B

baydeniro

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Merhaba arkadaşlar. Bir hücrede veri değişince (eski veri Karpuz iken Vişne oldu) hücre açıklama notuna "user name-eski veri-tarih saat" i makro ile otomatik kaydetmek mümkün mü ?
 

Ekli dosyalar

Merhaba,

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

Kod: 
Public EskiDeger As String
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:B]) Is Nothing Or Target.Row < 2 Then Exit Sub
    On Error GoTo Ilk_Defa_Aciklama_Eklenecek
    Dim Txt As String
    If Not Target.Comment.Text = "" Then
        
        With Target
            Txt = .Comment.Text
            .Comment.Text Text:= _
            Txt & Chr(10) & _
                Application.UserName & " " & Now & " Eski Değer : " & EskiDeger
        End With
    
    End If
    
    Exit Sub
Ilk_Defa_Aciklama_Eklenecek:
    If Err.Number = 91 Then
        With Target
            .AddComment
            .Comment.Visible = False
            .Comment.Text Text:=Application.UserName & " " & Now & " İlk Açıklama"
        End With
    
    End If
    
End Sub

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Intersect(Target, [A:B]) Is Nothing Or Target.Row < 2 Then Exit Sub
    
    EskiDeger = Target.Value
    
End Sub
 

Ekli dosyalar

Merhaba,

Necdet bey elinize sağlık. Küçük bir ekleme daha yaparsanız daha kullanışlı olacaktır.

Eklenen açıklamalar arttıkça açılan listede görünmüyor. Açıklama eklendikçe açıklama kutucuğunun boyutu otomatik genişlerse daha işlevsel olacaktır.
 
Çok teşekkür ederim Sayın Necdet Yeşertener, çok işime yarayacak. Üstadların sayesinde (Allah hepinizden razı olsuın) kod konusunda naçizane gelişmem oldu. Aşağıdaki kod satırında "İlk Açıklama" yerine Target.Value yazarak istediğim sonucu elde edebildim.

.Comment.Text Text:=Application.UserName & " " & Now & " İlk Açıklama"
 
Korhan Ayhan' Alıntı:
Merhaba,

Necdet bey elinize sağlık. Küçük bir ekleme daha yaparsanız daha kullanışlı olacaktır.

Eklenen açıklamalar arttıkça açılan listede görünmüyor. Açıklama eklendikçe açıklama kutucuğunun boyutu otomatik genişlerse daha işlevsel olacaktır.
Genişletmek için tıkla ...

Korhan bey sizi mi kırayım? :)

Yine aşağıdaki kodlar ilgili sayfanın kod bölümünde olmalı.

Kod: 
Public EskiDeger As String
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:B]) Is Nothing Or Target.Row < 2 Then Exit Sub
    On Error GoTo Ilk_Defa_Aciklama_Eklenecek
    Dim Txt As String
    If Not Target.Comment.Text = "" Then
        
        With Target
            Txt = .Comment.Text
            With .Comment
                .Visible = False
                .Text Text:= _
                    Txt & Chr(10) & _
                        Application.UserName & " " & Now & " Eski Değer : " & EskiDeger
                With .Shape
                    With .TextFrame
                        .HorizontalAlignment = xlLeft
                        .VerticalAlignment = xlTop
                        .ReadingOrder = xlContext
                        .Orientation = msoTextOrientationHorizontal
                        .AutoSize = True
                    End With
                End With
            End With
        End With
            
    End If
    
    Exit Sub
Ilk_Defa_Aciklama_Eklenecek:
    If Err.Number = 91 Then
        With Target
            .AddComment
            With .Comment
                .Visible = False
                .Text Text:= _
                    Txt & Chr(10) & _
                        Application.UserName & " " & Now & " İlk Açıklama"
                With .Shape
                    With .TextFrame
                        .HorizontalAlignment = xlLeft
                        .VerticalAlignment = xlTop
                        .ReadingOrder = xlContext
                        .Orientation = msoTextOrientationHorizontal
                        .AutoSize = True
                    End With
                End With
            End With
        End With
    
    End If
    
End Sub

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Intersect(Target, [A:B]) Is Nothing Or Target.Row < 2 Then Exit Sub
    
    EskiDeger = Target.Value
    
End Sub
 

Ekli dosyalar

Merhaba,

Bu daha kullanışlı oldu. Tekrar elinize sağlık.
 
Çok teşekkür ederim sayın üstadlarım. Sizlerin bu vizyon genişliğiniz bizlere de feyz oluyor. Bu koda şöyle bir özellik eklenebilir mi acaba ?
İlk değişkilik Comment Text boş ise olsun;
Comment Text dolu ise değişikliğe izin vermesin gibi ...
 
serdarokan' Alıntı:
Çok teşekkür ederim sayın üstadlarım. Sizlerin bu vizyon genişliğiniz bizlere de feyz oluyor. Bu koda şöyle bir özellik eklenebilir mi acaba ?
İlk değişkilik Comment Text boş ise olsun;
Comment Text dolu ise değişikliğe izin vermesin gibi ...
Genişletmek için tıkla ...

Aşağıdaki kodlar yine sayfanın kod bölümünde olmalı.

Tam denemedim, deneyip sonucu söylerseniz sevinirim.

Kod: 
Public EskiDeger As String

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:B]) Is Nothing Or _
       Target.Row < 2 Or _
       EskiDeger = "" Or _
       Selection.Count > 1 Then Exit Sub
    On Error GoTo Ilk_Defa_Aciklama_Eklenecek
    Dim Txt As String
    If Not Target.Comment.Text = "" Then
        Application.EnableEvents = False
        Target.Value = EskiDeger
        If IsNumeric(Target.Value) = True Then Target.Value = Target.Value * 1
        Application.EnableEvents = True
        Exit Sub
    End If
    
Ilk_Defa_Aciklama_Eklenecek:
    If Err.Number = 91 Then
        With Target
            .AddComment
            With .Comment
                .Visible = False
                .Text Text:= _
                    Txt & Chr(10) & _
                        Application.UserName & " " & Now & " Önceki Değer : " & EskiDeger
                With .Shape
                    With .TextFrame
                        .HorizontalAlignment = xlLeft
                        .VerticalAlignment = xlTop
                        .ReadingOrder = xlContext
                        .Orientation = msoTextOrientationHorizontal
                        .AutoSize = True
                    End With
                End With
            End With
        End With
    
    End If
    
End Sub

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Intersect(Target, [A:B]) Is Nothing Or Target.Row < 2 Or Selection.Count > 1 Then Exit Sub
    
    EskiDeger = Target.Value
    
End Sub
 

Ekli dosyalar

Sonuç mükemmel sayın Necdet Yeşertener. Elinize, emeğinize sağlık.
 
Sayın Necdet Yeşertener, konu geliştikçe insanın aklına yeni fikirler geliyor. Bu koda mesaj eklemöey çalıştım, ancak Comment olan olmayan her yerde mesaj verdiği için başarılı olamadım. Acaba sadece Comment Text'i dolu olan hücrelerde değiştirme girişimde belirecek mesajı nasıl bu koda monte edebilirim ?
 
serdarokan' Alıntı:
Sayın Necdet Yeşertener, konu geliştikçe insanın aklına yeni fikirler geliyor. Bu koda mesaj eklemöey çalıştım, ancak Comment olan olmayan her yerde mesaj verdiği için başarılı olamadım. Acaba sadece Comment Text'i dolu olan hücrelerde değiştirme girişimde belirecek mesajı nasıl bu koda monte edebilirim ?
Genişletmek için tıkla ...


Merhaba,

Bu istek bana pek mantıklı gelmedi. Uğraştığımız konuya göre, açıklama yoksa değişiklik yapılabilecekti.

Şimdi ise açıklama varsa değişikliğe izin vermek gerekiyor. Bu durumda ise önce açıklama eklenmeli (tabi el ile) sonra açıklama var mı diye kontrol etmeli.

Siz yinede bir düşünün, illa olsun derseniz önceki kodlar üzerinde düzenleme yapabiliriz.
 
Çok teşekkürler, çok dikkatlisiniz. Aslında mesaj sadece bilgilendirme amaçlı. Yani kodun algoritmasında, çalışmasında bir değişikliğe kesinlikle gerek yok. Eğer daha önce değişiklik yapılmışsa yani Comment Text dolu ise sizin kodunuz sayesinde değişikliğe izin vemriyor ya !! hah işte tam bu noktada kullanıcıya neden değişiklik izni vermediğinin bilgisini veriyor.
 
Öncelikle mükemmel bir çalışma olmuş..
belirtmek istediğim iki husus var
1- Kodun geçerli olduğu A B sütunları arasında çoklu seçim (taralı alan) seçince hata veriyor.
2- Uygulanacak sütunları aralık şeklinde değilde örnek olarak B , E ve K sütunlarını nasıl seçeriz. Tabi bu sütunlarda da çoklu seçim hatası vermemesi lazım.

olur mu bilmem ama emeği geçen herkese defalarca teşekkür ediyorum.
 
kaya41' Alıntı:
Öncelikle mükemmel bir çalışma olmuş..
belirtmek istediğim iki husus var
1- Kodun geçerli olduğu A B sütunları arasında çoklu seçim (taralı alan) seçince hata veriyor.
2- Uygulanacak sütunları aralık şeklinde değilde örnek olarak B , E ve K sütunlarını nasıl seçeriz. Tabi bu sütunlarda da çoklu seçim hatası vermemesi lazım.

olur mu bilmem ama emeği geçen herkese defalarca teşekkür ediyorum.
Genişletmek için tıkla ...

Merhaba,

Üzerinde baya düşünmek ve kodları değiştirmek gerek. Sanırım olabilir.

Ama şu an vaktim yok, inşallah başka bir zaman üzerinde tekrar çalışırım konunun, eğer çözüm gelmezse.

İkinci sorunuzun yanıtı kolay.

If Intersect(Target, [A:B]) .....
gibi bir kontrol sadece A ve B sütunlar içinde geçerlidir.
[A:A, C:C, M:N] gibi yazılarsan sadece a, c m ve n sütunlarında kontrol eder.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst