TextBox'a girilen değeri kitapta bulup o değerin bulunduğu satırı silme

[ruhadam26]

Selamın aleyküm Bir çalışma kitabında daha önceden girilmiş olan verilerden Defter NO Sütununda bulunan numarayı bir yerden aratıp o değerin bulunduğu satırı silmek istiyorum. Forumda buna benzer yapılmış örnekler var ama benim değerlerim sabit değil birden fazla ve sürekli değişmektedir. O yüzden bir textbox'a yada başka bir yere yazıp orada yazan değerin bulunduğu satırları silmek istiyorum.Bu işlemin tek bir sayfada değil çalışma kitabındaki tüm sayfalarda arayıp silmesini istiyorum. İlgi alaka ve yardımlarınız içi şimdiden teşekkür ederim. İyi çalışmalar dilerim.Örnek dosyam ektedir.

 

[N.Ziya Hiçdurmaz]

yanıt

Private Sub CommandButton1_Click()
Dim sat, i As Integer
For i = 1 To 8
For sat = 2 To Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row
    If Sheets(i).Cells(sat, "a") = ComboBox1.Text Then
        Sheets(i).Cells(sat, "a").EntireRow.Delete shift:=xlUp
    End If
Next
Next
Call UserForm_Initialize
End Sub
Private Sub UserForm_Initialize()
Dim sat, i As Integer
ComboBox1.Clear
For i = 1 To 8
For sat = 2 To Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row
    If WorksheetFunction.CountIf(Sheets(i).Range("a2:A" & sat), Sheets(i).Cells(sat, "a")) = 1 Then
        If Sheets(i).Cells(sat, "a") <> "" And Not IsNumeric(Sheets(i).Cells(sat, "a")) Then
            ComboBox1.AddItem Sheets(i).Cells(sat, "a")
        End If
    End If
Next
Next
End Sub

userform üzerine bir adet ComboBox1 bir adet CommandButton1 ekleyip kodu form içerisine yapıştırıp deneyiniz.

 

[ruhadam26]

private sub commandbutton1_click()
dim sat, i as ınteger
for i = 1 to 8
for sat = 2 to sheets(i).cells(rows.count, "a").end(xlup).row
    ıf sheets(i).cells(sat, "a") = combobox1.text then
        sheets(i).cells(sat, "a").entirerow.delete shift:=xlup
    end ıf
next
next
call userform_ınitialize
end sub
private sub userform_ınitialize()
dim sat, i as ınteger
combobox1.clear
for i = 1 to 8
for sat = 2 to sheets(i).cells(rows.count, "a").end(xlup).row
    ıf worksheetfunction.countıf(sheets(i).range("a2:a" & sat), sheets(i).cells(sat, "a")) = 1 then
        ıf sheets(i).cells(sat, "a") <> "" and not ısnumeric(sheets(i).cells(sat, "a")) then
            combobox1.addıtem sheets(i).cells(sat, "a")
        end ıf
    end ıf
next
next
end sub

userform üzerine bir adet combobox1 bir adet commandbutton1 ekleyip kodu form içerisine yapıştırıp deneyiniz.

hocam denedim ama bir fark göremedim çalışmadı kodu yanlış yere mi kopyaladım acaba yazdığım değerin bulunduğu satırı silmedi

 

[ruhadam26]

Çalıştı ama tam istediğim gibi çalışmıyor başka şeylerde siliyor silmesi gerekenleri silmiyor. Mesela arattığım değer 5 satır sadece birisini siliyor. Bİrde satırın tamamını değilde yarısının silmesini sağlayabilir miyiz.Birde Örneğin; 4. satırın a,b,c,d,e,f,g,h sütunlarını silsin. (a )da ve( ı) da aradığımız eğer olacak. eğer a sütunundaysa a dan h a kadar silsin. I sütunundaysa ı dan p ye kadar silsin. ve satırları boşluk kalmadan kaydırmadan kaydırsın 1 haftadır uğraşiyorum bir türlü çözüm bulamadım aslında tam olarak yapmak istediğim bu. şimdiden teşekkürler

 

[N.Ziya Hiçdurmaz]

yanıt

Private Sub CommandButton1_Click()
Dim sat, i As Integer
If ComboBox1.Text <> "" And ComboBox2.Text <> "" Then
    MsgBox "Yanlız bir seçim yapılmalıdır.", vbInformation
    Exit Sub
End If
If ComboBox1.Text <> "" Then
For i = 1 To 8
For sat = Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row To 2 Step -1
    If Sheets(i).Cells(sat, "a") = ComboBox1.Text Then
        Range(Sheets(i).Cells(sat, "a"), Sheets(i).Cells(sat, "h")) = "" '.EntireRow.Delete shift:=xlUp
    End If
Next
Next
Call UserForm_Initialize
End If
'
If ComboBox2.Text <> "" Then
For i = 1 To 8
For sat = Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row To 2 Step -1
    If Sheets(i).Cells(sat, "I").Value = ComboBox2.Text Then
        Range(Sheets(i).Cells(sat, "I"), Sheets(i).Cells(sat, "P")) = "" '.EntireRow.Delete shift:=xlUp
    End If
Next
Next
Call UserForm_Initialize
End If
End Sub
Private Sub UserForm_Initialize()
Dim sat, i As Integer
ComboBox1.Clear
For i = 1 To 8
For sat = 2 To Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row
    If WorksheetFunction.CountIf(Sheets(i).Range("a2:A" & sat), Sheets(i).Cells(sat, "a")) = 1 Then
        If Sheets(i).Cells(sat, "a") <> "" And Not IsNumeric(Sheets(i).Cells(sat, "a")) Then
            ComboBox1.AddItem Sheets(i).Cells(sat, "a")
        End If
    End If
Next
Next
'
ComboBox2.Clear
For i = 1 To 8
For sat = 2 To Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row
    If WorksheetFunction.CountIf(Sheets(i).Range("I2:I" & sat), Sheets(i).Cells(sat, "I")) = 1 Then
        If Sheets(i).Cells(sat, "I") <> "" Then
            ComboBox2.AddItem Replace(Sheets(i).Cells(sat, "I"), ".", ",")
        End If
    End If
Next
Next
End Sub

foruma bir buton iki combo ekleyip deneyiniz.

 

[ruhadam26]

Private Sub CommandButton1_Click()
Dim sat, i As Integer
If ComboBox1.Text <> "" And ComboBox2.Text <> "" Then
    MsgBox "Yanlız bir seçim yapılmalıdır.", vbInformation
    Exit Sub
End If
If ComboBox1.Text <> "" Then
For i = 1 To 8
For sat = Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row To 2 Step -1
    If Sheets(i).Cells(sat, "a") = ComboBox1.Text Then
        Range(Sheets(i).Cells(sat, "a"), Sheets(i).Cells(sat, "h")) = "" '.EntireRow.Delete shift:=xlUp
    End If
Next
Next
Call UserForm_Initialize
End If
'
If ComboBox2.Text <> "" Then
For i = 1 To 8
For sat = Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row To 2 Step -1
    If Sheets(i).Cells(sat, "I").Value = ComboBox2.Text Then
        Range(Sheets(i).Cells(sat, "I"), Sheets(i).Cells(sat, "P")) = "" '.EntireRow.Delete shift:=xlUp
    End If
Next
Next
Call UserForm_Initialize
End If
End Sub
Private Sub UserForm_Initialize()
Dim sat, i As Integer
ComboBox1.Clear
For i = 1 To 8
For sat = 2 To Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row
    If WorksheetFunction.CountIf(Sheets(i).Range("a2:A" & sat), Sheets(i).Cells(sat, "a")) = 1 Then
        If Sheets(i).Cells(sat, "a") <> "" And Not IsNumeric(Sheets(i).Cells(sat, "a")) Then
            ComboBox1.AddItem Sheets(i).Cells(sat, "a")
        End If
    End If
Next
Next
'
ComboBox2.Clear
For i = 1 To 8
For sat = 2 To Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row
    If WorksheetFunction.CountIf(Sheets(i).Range("I2:I" & sat), Sheets(i).Cells(sat, "I")) = 1 Then
        If Sheets(i).Cells(sat, "I") <> "" Then
            ComboBox2.AddItem Replace(Sheets(i).Cells(sat, "I"), ".", ",")
        End If
    End If
Next
Next
End Sub

foruma bir buton iki combo ekleyip deneyiniz.

Hocam soldaki combobox işçilikteki veriyi siliyor. Sağdaki de malzemeyi çok iyi istediğim şekilde oldu emeğinize sağlık çok teşekkürler. Yalnız bir sorun var sildiği hücreleri boş bırakıyor.Boş kalsın istemiyorum. hücreleri yukarı kaydırarak formüller bozulmadan silinen hücrelerin yerine aşağıdakiler gelse harika olacak. Bir de ufak bir ricam 1. combobox'a yazdığımız değer aynı zamanda 2. yede yazılsa tadından yenmez

 

[N.Ziya Hiçdurmaz]

yanıt

Private Sub CommandButton1_Click()
Dim sat, i As Integer
Application.ScreenUpdating = False
If ComboBox1.Text <> "" Then
For i = 1 To 8
For sat = Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row To 2 Step -1
    If Sheets(i).Cells(sat, "a") = ComboBox1.Text Then
        Range(Sheets(i).Cells(sat, "a"), Sheets(i).Cells(sat, "h")).Delete shift:=xlUp
    End If
Next
Next
Call UserForm_Initialize
End If
'
If ComboBox2.Text <> "" Then
For i = 1 To 8
For sat = Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row To 2 Step -1
    On Error Resume Next
    If Sheets(i).Cells(sat, "I") = ComboBox2.Text Then
        Range(Sheets(i).Cells(sat, "I"), Sheets(i).Cells(sat, "P")).Delete shift:=xlUp
    End If
Next
Next
Call UserForm_Initialize
End If
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
Dim sat, i As Integer
On Error Resume Next
ComboBox1.Clear
For i = 1 To 8
For sat = 2 To Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row
    If WorksheetFunction.CountIf(Sheets(i).Range("a2:A" & sat), Sheets(i).Cells(sat, "a")) = 1 Then
        If Sheets(i).Cells(sat, "a") <> "" And Not IsNumeric(Sheets(i).Cells(sat, "a")) Then
            ComboBox1.AddItem Sheets(i).Cells(sat, "a")
        End If
    End If
Next
Next
'
ComboBox2.Clear
For i = 1 To 8
For sat = 2 To Sheets(i).Cells(Rows.Count, "a").End(xlUp).Row
    If WorksheetFunction.CountIf(Sheets(i).Range("I2:I" & sat), Sheets(i).Cells(sat, "I")) = 1 Then
        If Sheets(i).Cells(sat, "I") <> "" Then
            ComboBox2.AddItem Replace(Sheets(i).Cells(sat, "I"), ".", ",")
        End If
    End If
Next
Next
End Sub