karşılaştır yoksa uyarı ver!!

[imyourfate]

Değerli hocalarım iyi akşamlar,

aşağıda eklediğim makroda S,T,U sütunlarındaki rakamlardan birinin aynısı şayet A ve R sütunları arasında varsa siliyor benim bu makroya eklemek istediğim tabiki olursa S,T,U sütunlarında olupda A ve R sütunları arasında bulunamayan rakamları (sadece sayıları tarih,yazı,harf vb. değil)bir uyarı ile birdirmesi örnek 1330 nolu sayı bulunamamıştır.

ekli dosya mevcuttur
Saygılar

Şimdiden teşekkür ederim

Sub BLOKE()
Dim ts, kaplan, trabzonspor, hamsi As Date
trabzonspor = MsgBox("Bloke Odaları Sil", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
For ts = 3 To Cells(Rows.Count, "A").End(xlUp).Row
For kaplan = 1 To 18
If WorksheetFunction.CountIf(Range("S3:U35"), Cells(ts, kaplan)) > 0 Then
Cells(ts, kaplan).ClearContents
End If
Next
Next
End Sub
Sub Son()

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub TEMİZLE()
    Dim Hücre As Range, Bul As Range
    Dim Bulunamayanlar As String
    
    For Each Hücre In Range("S3:U33")
        If Hücre.Value <> "" Then
            Set Bul = Range("A:R").Find(Hücre.Value, , , xlWhole)
            If Not Bul Is Nothing Then
                Bul.ClearContents
            Else
                If IsNumeric(Hücre.Value) Then
                    If Bulunamayanlar = "" Then
                        Bulunamayanlar = Hücre.Value
                    Else
                        Bulunamayanlar = Bulunamayanlar & ", " & Hücre.Value
                    End If
                End If
            End If
        End If
    Next
    
    Set Bul = Nothing
    
    If Bulunamayanlar <> "" Then
        MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
        "Aşağıdaki numaralar bulunamadı !" & Chr(10) _
        & Bulunamayanlar, vbExclamation
    Else
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
End Sub

 

[imyourfate]

Korhan bey çok güzel olmuş elinize sağlık tek kelimeyle harika

Saygılarımı sunarım