Satır yerine Hücreleri silme

[seddur]

Arkadaşlar Merhaba.Textbox1 ile H sütununa tarih,textbox2 ile "I" sütununa isim ve "J" sutununa saat giriyorum.Yapmak istediğim textbox1 ve 2'deki değere göre sadece "H","I" ve "J" sütunundaki hücrelerde bulunan değeri silmek.Yani satır silinmeyecek sadece o satırın "H-I-J" hücreleri silinecek.Yapabilecek arkadaşa Teşekkür ediyorum.

 

[ÖmerFaruk]

Mevcuttaki verileeriniz ve textboxlarınızı da içeren örnek dosyanızı paylaşır mısınız?

 

[fehdur]

Sizin için örnek dosya oluşturacaktım ama aynı kodlar farklı dosyada hata veriyor sebebini anlayamadım.Mevcut dosya ise karışık durumda.

 

[ÖmerFaruk]

Mevcut kodlarınızda hücre silinsin satır silinmesin dediğiniz noktada, satırları silen kod satırınızı da paylaşsanız olur.

 

[fehdur]

Dediğiniz kod ayrı butonda çalışıyor ve isme göre silme yapıyor.İsimler A sutununda ve combobox1 den seçiliyor.Seçilen isme ait bütün kayıtlar siliniyor.Şimdiki ise satır yerine sadece hücre silecek.Mevcut kodu aşağıda paylaşıyorum.

Dim St As Worksheet, c As Range, Adr As String, d As Range

Set St = Sheets("Takip")

Application.ScreenUpdating = False

Set c = St.[A:A].Find(ComboBox1.Value, , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
If d Is Nothing Then
Set d = St.Rows(c.Row)
Else
Set d = Application.Union(d, St.Rows(c.Row))
End If
Set c = St.[A:A].FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If

If Not c Is Nothing Then
d.Delete
MsgBox "Silme Tamamladı."
End If

 

[seddur]

Bir fikir versin diye örnek dosya hazırladım.

 

[Korhan Ayhan]

Deneyiniz.

Private Sub CommandButton2_Click()
    Dim Bul As Range, Adres As String, Alan As Range
    
    If TextBox1 <> "" Then
        Set Bul = Range("A:A").Find(TextBox1.Value, , , xlWhole)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
                If Alan Is Nothing Then
                    Set Alan = Cells(Bul.Row, "H").Resize(1, 3)
                Else
                    Set Alan = Union(Alan, Cells(Bul.Row, "H").Resize(1, 3))
                End If
                
                Set Bul = Range("A:A").FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        Else
            MsgBox "Aranan veri bulunamadı!", vbExclamation
        End If
    
        If Not Alan Is Nothing Then
            Alan.ClearContents
            MsgBox "Bulunan veriler silinmiştir.", vbInformation
        End If
    End If
    
    Set Bul = Nothing
    Set Alan = Nothing
End Sub

 

[seddur]

Kodu uyarladım sorunsuz çalışıyor.Teşekkür ederim.