Hücre içine yazılan açıklamayı başka bi hücreye yazma

[sibelsıla]

Merhabalar,

Hücrede ki açıklamaları yan hücreye aktarabilmek istiyorum, verdiğiniz kodları ve dosyaları denedim ancak ne yazık ki olmuyor, yeni sürümler içinde kodlar mevcut mu? Mevcut ise paylaşabilir misiniz?

 

[Korhan Ayhan]

Yeni sürüm dediğiniz nedir?

Profilinizde sadece "Türkçe" ifadesi yazıyor. Bundan ne anlamalıyız.

 

[Seyit Tiken]

Bu şekilde deneyiniz.

Sub Açıklama_kopyala()
For h = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(h, "B") = Cells(h, "A").Comment.Text
Next
End Sub

 

[sibelsıla]

Yeni sürüm dediğiniz nedir?

Profilinizde sadece "Türkçe" ifadesi yazıyor. Bundan ne anlamalıyız.

Türkçe kısmını düzelttim. Terimleri çok iyi bilmiyorum kusura bakmayın.

Excel 2013 kullanıyorum ne yazık ki bu kodda işe yaramadı hata veriyor. başka bir yolu var mı?

yaklaşık 2300 satır var ve pek çoğunda açıklama var bu açıklamaları excel de dökmem gerekli yardımcı olabilirseniz çok sevinirim.

Teşekkürler

Bu şekilde deneyiniz.

Sub Açıklama_kopyala()
For h = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(h, "B") = Cells(h, "A").Comment.Text
Next
End Sub

 

[Korhan Ayhan]

3-5 satırlık örnek dosya paylaşırsanız konu net şekilde çözüme ulaştırılabilir.

 

[Seyit Tiken]

Örnek dosya yükleyiniz.

 

[sibelsıla]

Örnek dosyamı ekledim.
Desteğiniz için teşekkürler.

 

[Korhan Ayhan]

Ofis 365 için aşağıdaki gibi uygulayınız.

Dosyanızı açın.
ALT+F11 tuşlarına basarak kod editörünü açın.
Sonrasında INSERT menüsünden boş bir modül ekleyin.

Aşağıdaki kodu bu modüle yapıştırın.

Option Explicit

Function AÇIKLAMA_AL(Hücre As Range)
    Application.Volatile
    If Val(Application.Version) > 15 Then
        With Hücre
            If Not .CommentThreaded Is Nothing Then
                AÇIKLAMA_AL = .CommentThreaded.Text
            End If
        End With
    Else
        With Hücre
            If Not .Comment Is Nothing Then
                AÇIKLAMA_AL = .Comment.Text
            End If
        End With
    End If
End Function

Sonra excel sayfasına dönüp F2 hücresine aşağıdaki formülü yazıp alt hücrelere sürükleyiniz.

=AÇIKLAMA_AL(D2)

Son olarak dosyanızı "Makro İçerebilen Excel Çalışma Kitabı" formatında kayıt edin.

 

[Seyit Tiken]

Bu şekilde deneyiniz.

Sub Açıklama_kopyala()
On Error Resume Next
For h = 2 To Cells(Rows.Count, "D").End(xlUp).Row
Cells(h, "E") = Cells(h, "D").Comment.Text
Next
End Sub

 

[sibelsıla]

Ne yazık ki yine olmadı
Sanırım olmayacak, desteğiniz için teşekkürler.

 

[Korhan Ayhan]

#28 nolu mesajımı revize ettim.

Ofis 365 sürümünde işler biraz değişmiş.

Kullanıcı tanımlı fonksiyonu bu sürüm için yeniden düzenledim. Deneyebilirsiniz.

 

[sibelsıla]

Çok çok teşekkürler beni o kadar büyük bir dertten kurtardınız tekrar tekrar teşekkürler.

 

[cllgny]

Merhaba,

Alternatif olsun. Sn. Korhan Ayhan hocamın bir çalışmasını ekliyorum. Sanırım işinizi görür.

açıklama almak istediğinizde =AÇIKLAMA_AL(A1) yazmanız yeterli. A1 olan yeri kendi dosyanıza göre ayarlarsınız.

Function AÇIKLAMA_AL(Hücre As Range)
    Application.Volatile
    With Hücre
        If Not .Comment Is Nothing Then
            AÇIKLAMA_AL = .Comment.Text
        End If
    End With
End Function

Elinize sağlık. çok iyi geldi..