Hücrelere Açıklama Ekleme

[1Al2Ver]

Merhaba,

"VERİLER" sayfası "C2:C366" arasındaki verilerin ;

"GÜNLÜK" sayfasındaki tabloda olduğu gibi, ilgili tarihlere AÇIKLAMA olarak gelmesini,

"VERİLER" sayfası "C2:C366" arasına veri ilave ettiğimde de makronun ;

"GÜNLÜK" sayfasındaki tabloyu, yenilemesini, arzuluyorum.

Teşekkür ederim.

 

[Ziynettin]

Sub test()
    Dim sh1 As Worksheet, sh2 As Worksheet, alan As Range
    Dim a(), b(), i As Long, j As Byte
    Set sh1 = Sheets("VERİLER")
    Set sh2 = Sheets("GÜNLÜK")
    son = sh1.Cells(Rows.Count, 2).End(3).Row
    a = sh1.Range("B1:C" & son).Value
    Set dc = CreateObject("scripting.dictionary")

    For i = 2 To UBound(a)
        If Not IsEmpty(a(i, 2)) Then
            dc(a(i, 1)) = a(i, 2)
        End If
    Next i

    Set alan = sh2.Range("A2:X32")
    alan.ClearComments
    b = alan.Value

    For i = 1 To UBound(b)
        For j = 1 To UBound(b, 2) Step 2
            krt = b(i, j)
            If dc.exists(krt) Then
                sut = j
                With alan(i, j)
                    .AddComment
                    .Comment.Visible = False
                    .Comment.Text Text:=dc(krt)
                End With
            End If
        Next j
    Next i
End Sub

 

[dEdE]

Merhaba,
Alternatif ve sorunuzun

"VERİLER" sayfası "C2:C366" arasına veri ilave ettiğimde de makronun ;
"GÜNLÜK" sayfasındaki tabloyu, yenilemesini, arzuluyorum.

kısmına yanıt.

Aşağıdaki kodları Veriler sayfanızın kod bölümüne

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("C2:C366")) Is Nothing Then Exit Sub
    AciklamaEkle
End Sub

Aşağıdakileri de bir modüle yapıştırarak deneyiniz.

Sub AciklamaEkle()
Set sy1 = Sheets("GÜNLÜK").Range("A:X")
Set sy2 = Sheets("VERİLER")
sy1.ClearComments

For i = 2 To 366
If sy2.Cells(i, 3) <> "" Then
    Bul = CDate(sy2.Cells(i, 2))
    Yaz = sy2.Cells(i, 3)
        With sy1
            Set c = .Find(Bul)
            If Not c Is Nothing Then
                adr = c.Address
            End If
            sy1.Range(adr).AddComment Yaz
        End With
End If
Next i
End Sub

 

[1Al2Ver]

Sayın Ziynettin merhaba,

Duyarlığınız ve çözüm için teşekkür ederim, emeğinize sağlık.

Saygılarımla.

 

[1Al2Ver]

Sayın dEdE merhaba,

Duyarlığınız ve alternatif çözüm için teşekkür ederim, emeğinize sağlık.

Saygılarımla.

 

[assenucler]

Sayın 1A2Ver,


Eklediğiniz dosya için çok teşekkür ederim. Benim gibi, çok sayıda üyelerimize de yararlı olacaktır. Sağ olun, var olun.

Değerli üstatlarıma da emekleri için de teşekkür ederim.

Saygılar,
Selim

 

[1Al2Ver]

Sayın assenucler merhaba,

Nezaketiniz ve güzel sözleriniz için teşekkür ederim, sizler de sağ olun var olun,

Saygılarımla.

 

[1Al2Ver]

Merhaba,

"GÜNLÜK" sayfasında, açıklamaları silmek isterseniz ,

Modül'e

Sub Aciklama_Sil()
Set sy1 = Sheets("GÜNLÜK").Range("A:X")
If MsgBox("AÇIKLAMALAR Silinecek ! Emin misiniz ?", vbYesNo, "Sayın Yetkili") = vbNo Then Exit Sub
sy1.ClearComments
End Sub

Teşekkür ederim.