İki Kodu Birleştirmek

[hakki83]

Merhaba hocalarımız

Aşağıdaki Sub kodunu
SelectionChange kodunun içine dahil edebilir miyiz, tek kod olsun diye.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.OnKey "{DELETE}", "Deletee"
End Sub

Sub Deletee()
Dim Cell As Range
For Each Cell In Selection
Cell.ClearComments
Cell.ClearContents
Next Cell
End Sub

 

[cems]

deneyin

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Seçim değiştiğinde, DELETE tuşuna basıldığında işlem yapılacak
    If Not Intersect(Target, Me.Range("A1:Z100")) Is Nothing Then ' Belirli bir alanı sınırlandırabilirsiniz
        Application.OnKey "{DELETE}", "Deletee"
    End If
End Sub

Sub Deletee()
    Dim Cell As Range
    ' Seçilen hücrelerin yorumlarını ve içeriklerini temizle
    For Each Cell In Selection
        Cell.ClearComments
        Cell.ClearContents
    Next Cell
End Sub

 

[hakki83]

deneyin

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Seçim değiştiğinde, DELETE tuşuna basıldığında işlem yapılacak
    If Not Intersect(Target, Me.Range("A1:Z100")) Is Nothing Then ' Belirli bir alanı sınırlandırabilirsiniz
        Application.OnKey "{DELETE}", "Deletee"
    End If
End Sub

Sub Deletee()
    Dim Cell As Range
    ' Seçilen hücrelerin yorumlarını ve içeriklerini temizle
    For Each Cell In Selection
        Cell.ClearComments
        Cell.ClearContents
    Next Cell
End Sub

Cems hocam teşekkürler emeğinize sağlık da paylaştığınız kod benim yazdığımın aynısı. Hiç fark yok arada.

Ben tek kod olsun istemiştim. SelectionChange kodu.

 

[pitchoute]

Merhaba,bildiğim kadarıyla VBA'da bir Sub prosedürünü başka bir Sub prosedürünün içine dahil edemezsiniz. Sublar bağımsız olarak tanımlanmalıdır.

 

[hakki83]

Teşekkürler pitchoute hocam.

 

[Biolightant]

Merhaba,

....
Cell.ClearComments
....

Kodlarınızın amacı,
Kullanıcı Hücreyi veya Hücreleri seçip Delete tuşuna basınca
Hücrelerde Açıklama varsa onu da Temizlesin

Eğer kodlarınızın kurgusunu doğru anladıysam...

Dim PreviousValues As Collection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Cell As Range

    ' Collection nesnesini başlat
    Set PreviousValues = New Collection

    ' Her hücre için önceki değerleri kaydet
    On Error Resume Next
    For Each Cell In Target.Cells
        ' Her hücre adresini ve değerini string olarak ekle
        PreviousValues.Add Cell.Value, Cell.Address
    Next Cell
    On Error GoTo 0
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range
    Dim OldValue As Variant

    ' Her hücrede değişiklik kontrolü yap
    For Each Cell In Target.Cells
        On Error Resume Next
        OldValue = PreviousValues(Cell.Address)
        On Error GoTo 0
        
        ' Eğer hücre boşsa ve önceki değeri varsa, Açıklamayı (Yorumları) temizle
        ' Delete tuşuna basılmış
        If IsEmpty(Cell.Value) And Not IsEmpty(OldValue) Then
            Cell.ClearComments ' Açıklamayı (Yorumları) temizle
        End If
    Next Cell
End Sub

 

[hakki83]

Merhaba,


Kodlarınızın amacı,
Kullanıcı Hücreyi veya Hücreleri seçip Delete tuşuna basınca
Hücrelerde Açıklama varsa onu da Temizlesin

Eğer kodlarınızın kurgusunu doğru anladıysam...

Dim PreviousValues As Collection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Cell As Range

    ' Collection nesnesini başlat
    Set PreviousValues = New Collection

    ' Her hücre için önceki değerleri kaydet
    On Error Resume Next
    For Each Cell In Target.Cells
        ' Her hücre adresini ve değerini string olarak ekle
        PreviousValues.Add Cell.Value, Cell.Address
    Next Cell
    On Error GoTo 0
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range
    Dim OldValue As Variant

    ' Her hücrede değişiklik kontrolü yap
    For Each Cell In Target.Cells
        On Error Resume Next
        OldValue = PreviousValues(Cell.Address)
        On Error GoTo 0
       
        ' Eğer hücre boşsa ve önceki değeri varsa, Açıklamayı (Yorumları) temizle
        ' Delete tuşuna basılmış
        If IsEmpty(Cell.Value) And Not IsEmpty(OldValue) Then
            Cell.ClearComments ' Açıklamayı (Yorumları) temizle
        End If
    Next Cell
End Sub

Evet Biolightant hocam. Delete tuşuna basınca hem hücre içeriğini temizlesin hem de açıklamaları silsin.

İlk paylaştığım kod ile bunu yapıyordum fakat tek parça olabilir mi diye düşünmüştüm. Sanırım olmuyormuş.

Sizin paylaştığınız kodda

Sadece
Worksheet_Change
ya da sadece
Worksheet_SelectionChange
olarak birleştirilebilir mi?

 

[Biolightant]

Worksheet_Change
ya da sadece
Worksheet_SelectionChange
olarak birleştirilebilir mi?

Bence birleştirilmemeli

Çünkü:
hücrenin ilk hali ile son halini karşılaştırıp bu sayede Delete tuşuna basılıp basılmadığını anlıyoruz.

 

[pitchoute]

Birleştirme olarak en fazla şöyle yapılabilir bence;

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range
    On Error Resume Next
    For Each Cell In Target
        If Cell.Value = "" Then
            Cell.ClearComments
        End If
    Next Cell
    On Error GoTo 0
End Sub

Kodun mantığı şu, çalışma sayfasında herhangi bir değişiklik olduğunda tetiklenir. Delete tuşuna basıldığında da tetiklenir, çünkü hücrelerin içeriği değişmiş olur.

Denemeden önce lütfen yedek almayı unutmayın.

 

[Biolightant]

@pitchoute mantıklı, hücre içeriği boşsa açıklamayı sil

 

[pitchoute]

Aynen öyle

 

[Korhan Ayhan]

Merhaba,

Aslında DELETE tuşuna basma olayını ilk kullandığınız kodla kontrol etmek daha kolaydır. Bunun dışında API ile (GetKeyState ve GetAsyncKeyState) bu kontrol sağlanabiliyor. Fakat ben Laptop'ta denediğimde sağlıklı sonuç alamadım. Bu sebeple bu yöntemi önermiyorum. Zaten kod uzamış oluyor.

Bunun yerine DELETE tuşuna bastığınızda zaten hücrenin içeriği silinmiş olacağı için sadece açıklamaları silecek yöntemi uygulamak yeterli olacaktır.

Bu yöntemi diğer arkadaşlar paylaştılar. Ben sadece döngü kullanmadan yapılmasını sağladım. Daha hızlı sonuç verecektir.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
   
    On Error Resume Next
    Set Rng = Nothing
    Set Rng = Target.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
   
    If Not Rng Is Nothing Then Rng.ClearComments
   
    Set Rng = Nothing
End Sub

 

[hakki83]

Emeklerinize sağlık değerli hocalarımız.

 

[Biolightant]

hehe kodu biraz daha kısaltabildim sanırım.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Target.SpecialCells(xlCellTypeBlanks).ClearComments
    On Error GoTo 0
End Sub

 

[Korhan Ayhan]

On Error Resume Next (Bütün Hataları Yoksay) komutunu bahsetiğiniz şekilde kullanılmasını pek tasvip etmiyoruz. Çünkü bu şekilde hata kontrolünü elden bırakmış oluyorsunuz. Tabii ki bu kullanım yöntemi bir tercihtir. Ama riskli olabilir. Dikkatli olmak gerekir.

 

[Biolightant]

On Error Resume Next i kod parçasından sonra direk On Error GoTo 0 yapıp normal durumuna çeviriyorum.

kullanma sebebim
herhangi bir hücre topluluğu (A1:B14) içeriğini kopyalayıp başka bir yere yapıştırdığımda
A1:B14 hiç bir hücre boş değilse hata veriyor o bakımdan kullandım

 

[Korhan Ayhan]

Aslında tam olarak bahsettiğiniz şekilde olmuyor...

Neden derseniz;

On Error Resume Next komutu ile hataları gözardı et dedikten sonra hiçbir hata kontrolü yapmadan excele boş hücrelerin açıklamalarını sil diyorsunuz. Fakat bu aşamada excelin nasıl davranacağını bilmiyorsunuz. Yani direksiyonu excel bırakıyorsunuz. Bu sebeple bu işlemden sonra hataları tekrar On Error GoTo 0 ile açmak çok birşey ifade etmiyor.

Kodlamada HATA KONTROLLERİ önemlidir ve kullanmak gerekir.

Bu sebeple bu komutları nacizane ben yine de dikkatli kullanmanızı tavsiye ederim...

 

[Korhan Ayhan]

Açıklamamın biraz eksik kaldığını düşündüğüm için mesajımı düzenledim. Bu haliyle biraz daha açıklayıcı olacaktır.