Hücre değerini açıklamaya ekleme

[exes]

Merhaba
Sayın Hüseyin beyin aşağıda vermiş olduğu örneğe benzer bir problemim var

http://www.excel.web.tr/viewtopic.php?t=91

Sorum: A1:a20 arasına devamlı rakamlar giriyorum.
Bu rakamların her değişiminde o günün tarihi ve yazmış olduğum rakamı hücre içerisine (hücre açıklaması içindeki rakamlar silinmeden) bir alt satıra eklemesini istiyorum.
Ã?rnek
14/08/2004 tarihinde A1 hücresine 1.000 rakamını girdim.
A1 hücre açıklaması 14/08/2004 1.000
15/08/2004 tarihinde A1 hücresine 2.000 rakamını girdim.
A1 hücre açıklaması 1.satır 14/08/2004 1.000 2.satır 15/08/2004 2.000
Bu rakamların çoğalması mümkün

Bu şekilde bir makro ile bunu yapmak mümkünmü?
Saygılar

 

[donhuan]

Merhabalar
İstediğin şeyi doğru anladıysam yaptım ve bende çalıştı.
Þimdi A1 den A20 ye kadar her hücrede ayrı bilgilerin var ve bunları günlük değiştiriyorsun.Vede her hücrede ayrı ayrı açıklaman olmasını ve bu hücrelerin günlük değişimlerini kaydetsin istiyorsun.
Macroyu yazarken A1:A20 arasını baz aldım ve C1 hücresinede =bugün()
fonksiyonunu yazarak o günün tarihini yazdırdım.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim eski As String
If Not Intersect(Target, Range("A1:A20")) Is Nothing Then
yeni = Target.Value
eski = Target.Comment.Text
tarih = Range("c1").Value 'burdaki C1 o günün tarihinin yazdigi hücre.
Target.Comment.Text Text:=eski & tarih & " / " & yeni & Chr(10)
End If
End Sub

Bastaki if sadece A1 ve A20 arası hücrelere bilgi girdiğin zaman
açıklamaya bilgi yazması için.Range("A1:A20") değiştirerek bu
aralığı ayarlayabilirsin. Tek şart daha önceden elle A1 A20 arasına içi boş olan bir açıklama eklemen.(Ama içi boş olsun.Başlığı dahi olmasın)
A1 ile A20 arasındaki herhangi bir hücrede değişiklik yaptığın an, o hücreye ait açıklamada, o hücrede yaptığın değişiklik "tarih / eğişiklik" şeklinde kendiliğinden eklenir.

Kolay gelsin
:arkadas:

 

[genesis]

Elinize sağlık.

:bravo: :bravo: :bravo:

 

[exes]

Sayın donhuan
Vermiş olduğunuz cevap için çok teşekkürler.
Makro gayet güzel olmuş ellerinize sağlık
Diğer arkadaşlarında bu makrodan faydalanacağını zannediyorum.
Saygılarımla

 

[mlgs]

merhabalar bana bu makro tablomda kullanmak için lazım uygulamaya çalıştım ama olmadı hep hata alıyorum yani tam olarak nasıl yapacagımı bulamadım birde H1:H20 aralıgı nı sectim ama 2:2 ye başkabir sayfadaki omutla yeni satır ekleniyor. degişken atayıp H1 den sonrasını =dolusay +1 deyip kendiliginden eklenen açıklama gibi yapmaya çalıştım ÇÜNKİ BASKA SAYFADAN ŞÖYLEBİR KOMUT GELİYOR 2:2 seç ve satır ekle yani her ekledigim satırda otomatik H2 HÜCRESİNE kendiliginden içiboş açıklama eklencek.ve sonra hücredeğerini acıklamaya ekleme makrosu aktif olucak eklencek ornek yukleyemedim cok buyuk bir dosyamvar ama yukarıdaki hemen hemen mantıgı aynı yardım edebilirseniz sevinirim



Private Sub Worksheet_Change(ByVal Target As Range)

Range("H2").Select
Range("H2").AddComment
Range("H2").Comment.Visible = False
Range("H2").Comment.Text Text:=""
Selection.ShapeRange.ScaleWidth 2.08, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 2.04, msoFalse, msoScaleFromTopLeft

Dim eski As String
If Not Intersect(Target, Range("h2:h200")) Is Nothing Then

yeni = Target.Value
eski = Target.Comment.Text
tarih = Range("m1").Value 'burdaki m1 o günün tarihinin yazdigi hücre.
Target.Comment.Text Text:=eski & tarih & " / " & yeni & Chr(10)
End If
End Sub

 

[YUSUF44]

Noktalama işareti kullanırken biraz cimri davrandığınızdan için tam olarak ne istediğiniz anlamak zorlaşıyor. Ancak başka bir kodla sayfa olayları çalıştırılıyorsa ve siz bunun olmasını geçici olarak istemiyorsanız şöyle yapabilirsiniz:
Diğer sayfada satır eklemeyle ilgili kodların başına

ApplicationEnableEvents = False

satırını ve sonuna da

ApplicationEnableEvents = True

satırını eklerseniz, satır ekleme işlemi sırasında sayfa olayları geçici olarak durdurulur. Yani diğer sayfada işlem gören kodunuz şöyle olmalı:

satır eklemeden önceki kodlar
ApplicationEnableEvents = False
satır ekleme kodları
ApplicationEnableEvents = True
satır eklemeden sonraki kodlar


Burdaki false/true olayı çok önemlidir. Olur da herhangi bir şekilde hata vs nedeniyle sayfa olayları durdurulur ve öylece kalırsa tekrar çalıştırmak için dosyanızda aşağıdaki makroyu bir defaya mahsus çalıştırmalısınız:

sub aktif()
ApplicationEnableEvents = True
end sub

 

[mlgs]

yusuf 44 çok teşekkür ederim bir harf değil çok güzel bir kod öğrettin allah razı olsun özümü şu yolla buldum haırda olan satıra önce yapıştırma işlemini daha sonra yeni satır ekleme yaparak çözdüm ama yine söylüyorum allah razı olsun siz, biz ve bizim gibilerden bilgiyi paylaşarak çoğaltanlardan başkasına örnek olurdiyerek kodları ekliyorum
'
Sheets("anasayfa").Select
Range("M26:S26").Select
Selection.Copy
Range("N19").Select
'Sheets("ARAMA KAYITLARI ").Select
'Rows("2:2").Select
'Application.CutCopyMode = False
'Rows("2:2").Select
'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("ARAMA KAYITLARI ").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'burası arama kayıtlarına yeni satır ekler
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H2").AddComment
Range("H2").Comment.Visible = False
Range("H2").Comment.Text Text:=""
With Selection.Font
.Name = "Tahoma"
.FontStyle = "İnce"
.Size = 5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With



Sheets("anasayfa").Select
Range("R9").Select
Application.CutCopyMode = False
End Sub