İki sütunu karşılaştırarak istenileni silme

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar; ekli dosyamda İzinler Sayfamda P kolonundaki sicilleri (P2 den başlayan) B kolonunda bulacak benim isteğime göre EVET yada HAYIR diyerek bunları silmek istiyorum. Siteden araştırdım bir kod buldum ama çalıştıramadım. yani olmadı yardımcı olursanız sevinirim.

Sub SİL()
Dim SonSat As Long, x As Long, y As Long, ara As Range, sor, a As Long, d As String
SonSat = Range("B" & Rows.Count).End(xlUp).Row 'B sütununun son dolu satırı
x = Range("P" & Rows.Count).End(xlUp).Row

If Trim(Cells(a, "W")) = "ÖDENEK BEKLENİYOR" Then
Set ara = Range("B2:B" & SonSat).Find(Cells(a, "P"), , xlValues, xlWhole)
If Not ara Is Nothing Then
Cells(ara.Row, "G").Select 'Bakılacak hücreyi gösteriyor.
d = Cells(a, "P") & " sicil nolu" & vbCrLf & Cells(a, "s") & " " & Cells(a, "q") & " " & Cells(a, "u")
sor = MsgBox(d & vbCrLf & "tarihinde geçici göreve gittiğinden Listeden silinecek Onaylıyor musun?", vbYesNo)
If sor = vbYes Then
Range("A" & ara.Row & ":L" & ara.Row).Delete Shift:=xlUp
Cells(2, "A") = 1
SonSat = SonSat - 1
Cells(2, "A").AutoFill Destination:=Range("A2:A" & SonSat), Type:=xlFillSeries
Cells(a, "V") = "Listeden silindi"
End If: End If: End If
Next
Else
MsgBox "Silinecek personel bulunamadı"
End If
End Sub

 

[ÖmerFaruk]

Aşağıdaki kodu bir module içine yerleştirip çalıştırabilirsiniz.

Sub SİL()
Dim SonB As Long, SonP As Long, i As Integer, Bul As Range, Bulunan As String, xBul As Range
    SonB = Range("B" & Rows.Count).End(xlUp).Row 'B sütununun son dolu satırı
    SonP = Range("P" & Rows.Count).End(xlUp).Row
    For i = 2 To SonP
    Set Bul = Range("B1:B" & SonB).Find(Range("P" & i), , xlValues, xlWhole)
        If Not Bul Is Nothing Then
        Do
            For k = 1 To 11
                Bulunan = Bulunan & Cells(Bul.Row, k) & " - "
            Next k
                Bulunan = Left(Bulunan, Len(Bulunan) - 3)
            Mesaj = "Aradığınız " & Range("P" & i) & " sicil numarası " & Bul.Row & ". satırda bulundu"
            Mesaj = Mesaj & Chr(10) & Chr(10) & Bulunan
            Mesaj = Mesaj & Chr(10) & Chr(10) & "Silmek istiyor musunuz?"
            Cevap = MsgBox(Mesaj, vbYesNoCancel, "Sicil Bulundu")
            If Cevap = vbYes Then
                Set xBul = Bul.Offset(-1, 0)
                Range("A" & Bul.Row, "L" & Bul.Row).Delete Shift:=xlUp
            ElseIf Cevap = vbCancel Then
                Exit Do
            End If
            Bulunan = ""
            Set Bul = Range("B1:B" & SonB).FindNext(xBul)
            If Bul Is Nothing Then Exit Do
        Loop
        End If
    Next i
End Sub

 

[Hacı Bayram ÖZKAN]

Sayın Ömer abiciğim teşekkür ederim dua ile kal

 

[Hacı Bayram ÖZKAN]

Sayın Ömer abim kodları deneme fırsatı buldum ancak;
1. Bulduğunu hayır deyince

Run Time Error ‘5’
Invalid Procedure call or argument hatası veriyor.

Ancak ikinci hayırda bunu yapmıyor. Bu seferde diğer personellere geçmiyor.

Debug deyince
Set Bul = Range("B1:B" & SonB).FindNext(xBul) Bu satır sarı yanıyor.

Eğer ilk evet deyip bir personel silinince diğer personel için HAYIR deyince yani silme deyince burayı geçmiyor, yani personeli silmeyip diğer personeller için devam etmiyor.
İPTAL tuşu ile de mesaj kutusuna ekleme yapıyor. Buna gerek yok, bunun yerine silinen personeli “V veya T” kolonuna silinen personel için “Listeden Silindi” yazarsa daha uygun olacak hemde kontrolü sağlanmış olacak.
Dosyayı anlaşılması kolay olsun diye mantıklı düzenledim. O da ekte...

 

[ÖmerFaruk]

Son mesajınız eksik okuyarak çözmüştüm.
Bir inceleyin.

Evet tuşuna basınca siliyor
Hayır basınca aynı kişiyi tekrar aramaya devam ediyor
İptal basınca bir sonraki kişiyi arıyor.

Sub SİL()
Dim SonB As Long, SonP As Long, i As Integer, Bul As Range, Bulunan As String, xBul As Range
Dim TotalBulunan As Integer, TotalSilinen As Integer
    SonB = Range("B" & Rows.Count).End(xlUp).Row 'B sütununun son dolu satırı
    SonP = Range("P" & Rows.Count).End(xlUp).Row
    For i = 2 To SonP
    Set Bul = Range("B1:B" & SonB).Find(Range("P" & i), , xlValues, xlWhole)
        If Not Bul Is Nothing Then
        Do
            Bulunan = "": Mesaj = ""
            TotalFind = TotalFind + 1
            For k = 1 To 11
                Bulunan = Bulunan & Cells(Bul.Row, k) & " - "
            Next k
            Bulunan = Left(Bulunan, Len(Bulunan) - 3)
            Mesaj = "Aradığınız " & Range("P" & i) & " sicil numarası " & Bul.Row & ". satırda bulundu."
            Mesaj = Mesaj & Chr(10) & Chr(10) & Bulunan
            Mesaj = Mesaj & Chr(10) & Chr(10) & "Silmek istiyor musunuz?"
            Cevap = MsgBox(Mesaj, vbYesNoCancel, "Sicil Bulundu")
            Select Case Cevap
                Case vbYes
                Set xBul = Bul.Offset(-1, 0)
                Range("A" & Bul.Row, "L" & Bul.Row).Delete Shift:=xlUp
                TotalSilinen = TotalSilinen + 1
                Set Bul = xBul
                Case vbNo
                Case Else
                Exit Do
            End Select
            Set Bul = Range("B1:B" & SonB).FindNext(Bul)
            If Bul Is Nothing Then Exit Do
        Loop
        End If
    Next i
    MsgBox "Arama sonucu" & Chr(10) & "Bulunan : " & TotalFind & Chr(10) & "Silinen : " & TotalSilinen
End Sub

 

[Hacı Bayram ÖZKAN]

Sayın Ömer Faruk Abiciğim; çok güzel olmuş eline sağlık kodu anlatınca da daha iyi anladım, harika çalışıyor. teşekkürler. Dua ile kal.

 

[ÖmerFaruk]

Eyvallah.