Hücreyi Silince Satır Silinsin

[unfors]

"A" sütununda herhangi bir hücreyi "delete" ile silince başka işlem yapmadan satırın silinmesini istiyorum. Bunu makro ile Döngü'ye girmeden yapmak mümkün müdür?

 

[Korhan Ayhan]

Dosyanızın "ThisWorkBook" ya da "BuÇalışmaKitabı" bölümüne aşağıdaki kodu uygulayınız.

Private Sub Workbook_Activate()
    Application.OnKey "{DELETE}", "Satir_Sil"
End Sub

Private Sub Workbook_Deactivate()
    Application.OnKey "{DELETE}"
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If ActiveSheet.Name = "Sayfa1" Then
        Application.OnKey "{DELETE}", "Satir_Sil"
    Else
        Application.OnKey "{DELETE}"
    End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveSheet.Name = "Sayfa1" Then
        If Target.Column > 1 Then
            Application.OnKey "{DELETE}"
        Else
            Application.OnKey "{DELETE}", "Satir_Sil"
        End If
    End If
End Sub

Boş bir modüle aşağıdaki kodu uygulayınız.

Sub Satir_Sil()
    If ActiveSheet.Name = "Sayfa1" Then
        If ActiveCell.Column = 1 Then
            ActiveCell.EntireRow.Delete
        End If
    End If
End Sub

Dosyanızı makro içeren dosya şeklinde kayıt ediniz. Dosyanızı kapatıp tekrar açınız.

Kod "Sayfa1" isimli sayfanın "A" sütununda çalışacaktır.

 

[systran]

örnek çalışmayı inceleyiniz.
A sütununda DELETE tuşuna basınca tüm satırı siler,
onun haricindeki sütunlarda sadece hücre içeriği silinir.
https://drive.google.com/file/d/1jLA3FmOjSRDq0yE6kSxUUso2WsCHEdUT/view?usp=sharing

 

[Korhan Ayhan]

Bende kendi mesajımdaki kodlara küçük eklemeler yaptım. Son halini deneyebilirsiniz.

 

[unfors]

İki çalışmada mükemmel olmuş. Çok teşekkür ederim. Yalnız benim sayfamda sutunlar silinmesin diye aşağıdaki kod çalışıyor;

Private Sub Workbook_SheetChange(ByVal Sayfa As Object, ByVal Target As Range)
   
    If (Target.Address = Target.EntireColumn.Address) Then
        With Application
            .EnableEvents = False
            .Undo
            MsgBox "Sütunları Silemezsiniz!", 16
            .EnableEvents = True
        End With
    Else
        Exit Sub
    End If
End Sub

"entıre row del.xlsm" dosyasındaki

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Dim aCell As Range
   For Each aCell In Target.Cells '-- Target may contains more than one cells.
      If aCell.Formula = "" Then
         Application.EnableEvents = False
         Rows(aCell.Row).EntireRow.Delete
         Application.EnableEvents = True
      End If
   Next
End Sub

ile aynı anda çalışmıyorlar?