İki kriterli silme

[seddur]

Merhaba.Arkadaşlar aşağıdaki kod ile "A" sutununda tekrar eden aynı isimlerin hepsine ait satırları siliyorum.Yapmak istediğim combobox1'den seçtiğim isme ek olarak Textbox1'deki tarihe göre de silme işlemi yapsın.Yani iki kritere göre seçili satır silinsin.Böylece benzer isimlerin hepsini silmek yerine sadece belli isim ve tarihdeki satırı silmiş olacağım.Tarihler "B" sutununda.Teşekkürler.




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

 

[taytaykir]

Aynı döngüyü tekrar başlatıp "A" sütünu için koyduğun değerleri "B" sütününa uyarlasan olmaz mı?

 

[taytaykir]

Bende ListBox'ta seçtğm verileri Sheets("Sayfa1") de silmeyi başardım ancak benzer verilere sahip sadece ekleme yapılmış Sheets("Sayfa2") den silme işlemi yapamıyorum. Aslında Yapıyorum ancak sadece bir satırı siliyorum. Listbox1 i seçtiğimde listbox2 de birden fazla satır olabiliyor ama ben sadece bir satırı silebiliyorum.


Private Sub CommandSil_Click()
If MsgBox("Seçtiginiz Veri Silinecek,Eminmisiniz?", vbYesNo) = vbYes Then

For a = 0 To ListBox.ListCount - 1

If ListBox.Selected(a) Then
ara = ListBox.List(a, 0)
Sheets("Sayfa1").Range("A").Find(what:=ara, lookat:=xlWhole).EntireRow.Delete
End If
Next
End If
End Sub

 

[seddur]

Uyarlamaya çalıştım ama bir noktadan sonra bıkkınlık veriyor.Aslında aşağıdaki satıra textbox ilavesi yapılsa yeterli olur diye düşünüyorum.

Set c = St.[A:A].Find(ComboBox1.Value, , xlValues, xlWhole)

 

[seddur]

Arkadaşlar bulduğum bir kod ile iki kriterli silme işlemi yaptım ama şöyle textbox3 yazan yere silinecek satırdaki tarihi yazarsam satırı siliyor halbuki textbox3 de tarih var zaten ama tanımıyor.Kodu aşağıda paylaşıyorum,yardımlarınızı bekliyorum.

Dim S1 As Worksheet, c As Range, Adr As String, k As Range

Set S1 = Sheets("Takip")

Set c = S1.[A18:A500].Find(ComboBox1, , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
If S1.Cells(c.Row, "B") = TextBox3.Value Then
If k Is Nothing Then
Set k = S1.Rows(c.Row)
Else
Set k = Application.Union(k, S1.Rows(c.Row))
End If
End If
Set c = S1.[A:A].FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If

If Not k Is Nothing Then
Application.ScreenUpdating = False
k.Delete
Application.ScreenUpdating = True
MsgBox "Silme Tamamladı."
End If

 

[seddur]

Kodun ilgil satırını aşağıdaki şekilde değiştirince oldu.
If S1.Cells(c.Row, "B") =Clng(cdate(TextBox3.Value)) Then

 

[Korhan Ayhan]

Uyarlamaya çalıştım ama bir noktadan sonra bıkkınlık veriyor...

Demek ki bıkmamak gerekiyor..