İmlec üzerine getirildiğinde belirttiğimiz formül sonucunu gösteren açıklama eklemek

[akcayonline]

Merhaba arkadaşlar;

Amacım, excel ile verilen üretim planında, belirtilen satırdaki üretimin başlama ve bitiş zamanını plan adedinin yer aldığı hücrenin üzerine gelince açılan bir açıklama penceresinde gösterebilmek. Eklediğim dosyada alanları ve yapmak istediklerimi açıklamaya çalıştım, destekleriniz için şimdiden teşekkür ederim.

 

[hamitcan]

Sayfanın kod kısmıne ekleyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("h").ClearComments
    With Target
        .AddComment
        .Comment.Visible = True
        .Comment.Text Text:=Cells(Target.Row, "j") & Chr(10) & Cells(Target.Row, "k")
    End With
End Sub

 

[akcayonline]

Sayfanın kod kısmıne ekleyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("h").ClearComments
    With Target
        .AddComment
        .Comment.Visible = True
        .Comment.Text Text:=Cells(Target.Row, "j") & Chr(10) & Cells(Target.Row, "k")
    End With
End Sub

Teşekkürler cevap için. Kodu sayfaya ekledim, çalıştırdım fakat nereye tıklarsam tıklayayım orada açıklama açılıyor, benim istediğim sadece H sütununda açılması.
Diğer husus ;
farklı bir hücreye tıklandığında açık olan açıklamanın kapanmasını istiyorum, çünkü bu şekilde tüm sayfa açıklama pencereleri ile kaplandı.
Bu arada eklerken şunu farkettim ; sanırım J ve K sütunundan veri aldırdınız ama yapabiliyorsam benim amacım; bu sütunlar sayfada yer almadan , formülleri arkada hesaplayıp açıklamaya getirmek istiyordum. Çünkü sayfada sürekli satır sil satır ekle olduğu için her seferinde formül kopyalamak sıkıntı doğurabiliyor.

Desteğiniz için teşekkür ederim.

 

[hamitcan]

Bu şekilde deneyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column <> 8 Then Exit Sub
    Columns("h").ClearComments
    With Target
        .AddComment
        .Comment.Visible = True
        .Comment.Text Text:=Cells(Target.Row, "j") & Chr(10) & Cells(Target.Row, "k")
    End With
End Sub

 

[akcayonline]

teşekkür ederim desteğiniz için hamitcan Bey. Aslında 2 gün gec cevap vermemin sebebi, her detay için sizlerin vaktini almadan kendim birşeyler yapabiliyorsam yapmaktı ama makro bilgim yeterli olmadığı için ilerleyemedim. Dosya şu şekilde olabilse daha iyi olur ;
- açıklamalar sadece H sütunundaki hücreler aktif olduğunda açılacak (bu ok), h sütunu hariç herhangi bir alan aktif olduğunda açıklama kapanacak (şu an kapanmıyor)
-açıklamada çıktısı gösterilen formüller sayfada fiziken ayrı bir sütunda yer almayacak, formül arka planda çalışacak (böyle birşey mümkünmü bilmiyorum) "Bunun sebebi sayfada sürekli satır ekle, satır sil yapılıyor olması" Eğer satır ekle, satır sil yapıldığında yeniden formül kopyalamaya gerek olamayacak bir çözüm varsa o da olabilir.
-Şu an birden fazla hücre seçildiğinde makro hata veriyor, bu durumda seçili alandaki aktif hücre eğer h sütunundaysa açıklama açılacak..

 

[hamitcan]

Umarım eksik bir şey kalmamıştır.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("h").ClearComments
    With Target
         If .Count > 1 Then Exit Sub
         If .Row = 2 Then
             Txt1 = [n1]
             Txt2 = [n1] + ([h2] - [g2]) / [n2]
         Else
             Txt1 = Cells(.Row - 1, "k")
             Txt2 = Cells(.Row - 1, "j") + (Cells(.Row, "h") - Cells(.Row, "g")) / [n2]
         End If
         If .Column <> 8 Then Exit Sub
         If .Column <> 8 Then Columns("h").ClearComments
            .AddComment
            .Comment.Visible = True
            .Comment.Text Text:=Txt1 & Chr(10) & Txt2
    End With
End Sub

 

[akcayonline]

valla baya uğraştırdım sizi, sağolun eksik anlamında değilde ;

- h sütununda üzerine tıklanan hücre boş ise açıklama penceresi açılmasın,

-çıkan tarih formatında saniye bilgisi çıkmasın

- birde j ve k sütunu olmadan da makro çalışabilirse (formüller makronun içinde çalışabilirse) harika olur

 

[hamitcan]

Kod J ve K sütunlarına bağlı olmadan çalışmakta... Hücre boş ise konusunu ise aşağıdaki satırı ekleyerek hallettim.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("h").ClearComments
    With Target
         If .Count > 1 Then Exit Sub
         If .Value = "" Then Exit Sub ' Bu satırı ekledim.
         If .Row = 2 Then
             Txt1 = [n1]
             Txt2 = [n1] + ([h2] - [g2]) / [n2]
         Else
             Txt1 = Cells(.Row - 1, "k")
             Txt2 = Cells(.Row - 1, "j") + (Cells(.Row, "h") - Cells(.Row, "g")) / [n2]
         End If
         If .Column <> 8 Then Exit Sub
         If .Column <> 8 Then Columns("h").ClearComments
            .AddComment
            .Comment.Visible = True
            .Comment.Text Text:=Txt1 & Chr(10) & Txt2
    End With
End Sub

 

[akcayonline]

Kod J ve K sütunlarına bağlı olmadan çalışmakta... Hücre boş ise konusunu ise aşağıdaki satırı ekleyerek hallettim.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("h").ClearComments
    With Target
         If .Count > 1 Then Exit Sub
         If .Value = "" Then Exit Sub ' Bu satırı ekledim.
         If .Row = 2 Then
             Txt1 = [n1]
             Txt2 = [n1] + ([h2] - [g2]) / [n2]
         Else
             Txt1 = Cells(.Row - 1, "k")
             Txt2 = Cells(.Row - 1, "j") + (Cells(.Row, "h") - Cells(.Row, "g")) / [n2]
         End If
         If .Column <> 8 Then Exit Sub
         If .Column <> 8 Then Columns("h").ClearComments
            .AddComment
            .Comment.Visible = True
            .Comment.Text Text:=Txt1 & Chr(10) & Txt2
    End With
End Sub

j ve k sütununu sildiğimde kod h sütunundaki ilk hücre için çalışıyor diğerleri için çalışmıyor Hamitcan Bey, diğer konular ok, teşekkürler.

 

[hamitcan]

Bu şekilde dener misiniz ?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("h").ClearComments
    With Target
         If .Count > 1 Then Exit Sub
         If .Value = "" Then Exit Sub
         If .Row = 2 Then
             j= [n1]
             k = [n1] + ([h2] - [g2]) / [n2]
         Else
            J = [j2]
            k = [k2]
      
            For i = 3 To .Row
                t = J + (Cells(i, "h") - Cells(i, "g")) / [n2]
            J = k
            k = t
            Next
         End If
         If .Column <> 8 Then Exit Sub
         If .Column <> 8 Then Columns("h").ClearComments
            .AddComment
            .Comment.Visible = True
            .Comment.Text Text:=J & Chr(10) & k
    End With
End Sub

 

[akcayonline]

Bu şekilde dener misiniz ?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("h").ClearComments
    With Target
         If .Count > 1 Then Exit Sub
         If .Value = "" Then Exit Sub
         If .Row = 2 Then
             j= [n1]
             k = [n1] + ([h2] - [g2]) / [n2]
         Else
            J = [j2]
            k = [k2]
     
            For i = 3 To .Row
                t = J + (Cells(i, "h") - Cells(i, "g")) / [n2]
            J = k
            k = t
            Next
         End If
         If .Column <> 8 Then Exit Sub
         If .Column <> 8 Then Columns("h").ClearComments
            .AddComment
            .Comment.Visible = True
            .Comment.Text Text:=J & Chr(10) & k
    End With
End Sub

Hocam bu haliyle ekledim, J ve K sütunuandaki 2.satırı yine silmemek gerekiyordu, kodu aşağıdaki gibi değiştirdim (makro bilgim iyi değil, biraz deneme yanılma yöntemiyle değiştirdim) , şimdi J ve K sütununu tamamen silsemde makro çalışıyor fakat hesaplamada yanlışlık oluyor. Örneğin H3 hücresinde bitiş tarihi başlama tarihinden daha önce hesaplanıyor.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("h").ClearComments
    With Target
         If .Count > 1 Then Exit Sub
         If .Value = "" Then Exit Sub
         If IsNumeric(.Value) = False Then Exit Sub
         If .Row = 2 Then
             J = [n1]
             k = [n1] + (([h2] - [g2]) / [n2])
         Else
            J = [n1]
            k = [n1] + (([h2] - [g2]) / [n2])
      
            For i = 3 To .Row
                t = J + (Cells(i, "h") - Cells(i, "g")) / [n2]
            J = k
            k = t
            Next
         End If
         If .Column <> 8 Then Exit Sub
         If .Column <> 8 Then Columns("h").ClearComments
            .AddComment
            .Comment.Visible = True
            .Comment.Text Text:=J & Chr(10) & k
    End With
End Sub

 

[hamitcan]

J2 ve K2 hücreleri kalmalı mı yoksa tamamen iki sütun(j ve k) silinmeli mi ?

 

[akcayonline]

J2 ve K2 hücreleri kalmalı mı yoksa tamamen iki sütun(j ve k) silinmeli mi ?

Tamamen silinmeli

 

[hamitcan]

Böyle deneyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("h").ClearComments
    With Target
         If .Count > 1 Then Exit Sub
         If .Value = "" Then Exit Sub
         If .Row = 2 Then
             J = [n1]
             k = [n1] + ([h2] - [g2]) / [n2]
         Else
            J = [n1]
            k = [n1] + ([h2] - [g2]) / [n2]
       
            For i = 3 To .Row
                t = J + (Cells(i, "h") - Cells(i, "g")) / [n2]
            J = k
            k = t
            Next
         End If
         If .Column <> 8 Then Exit Sub
         If .Column <> 8 Then Columns("h").ClearComments
            .AddComment
            .Comment.Visible = True
            .Comment.Text Text:=J & Chr(10) & k
    End With
End Sub

 

[akcayonline]

Böyle deneyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("h").ClearComments
    With Target
         If .Count > 1 Then Exit Sub
         If .Value = "" Then Exit Sub
         If .Row = 2 Then
             J = [n1]
             k = [n1] + ([h2] - [g2]) / [n2]
         Else
            J = [n1]
            k = [n1] + ([h2] - [g2]) / [n2]
     
            For i = 3 To .Row
                t = J + (Cells(i, "h") - Cells(i, "g")) / [n2]
            J = k
            k = t
            Next
         End If
         If .Column <> 8 Then Exit Sub
         If .Column <> 8 Then Columns("h").ClearComments
            .AddComment
            .Comment.Visible = True
            .Comment.Text Text:=J & Chr(10) & k
    End With
End Sub

Hamitcan Bey, defalarca uğraştınız , gerçekten çok teşekkür ederim. İnanın bundan sonrası için artık yazarken utanıyorum, ama şu an bazı hesaplamalarda hata var, bazı hücrelerde bitiş tarihi başlama tarihinden önce görünüyor, ben J ve K sütununa olması gereken başlama ve bitiş tarihlerini formülle yeniden yazdırdım. Bu şekilde dosyayı ekliyorum. Makro ile bu değerler farklı çıkıyor, sanırım bir noktada farklı birşey var.

Bu vesile ilede mesajları okuyan herkesin Kurban Bayramını tebrik ediyorum.

 

[hamitcan]

Tabii ki tutmaz. Çünkü formülleri değiştirmişsiniz. Benden bu kadar. İyi Bayramlar Size.
İlk formül;

=J3+((H4-G4)/$N$2)

Sonraki formül;

=EĞER(G3="";J3+(H3/$N$2);J3+(G3/$N$2))

 

[akcayonline]

Teşekkür ederim