Soru Veri bulunamadığında kodun çalışmayı durdurması

Katılım
19 Mayıs 2015
Mesajlar
239
Excel Vers. ve Dili
2010 türkçe
Altın Üyelik Bitiş Tarihi
09-07-2021
Merhaba,

Ekte ki dosya tanımlı kod ile birinci sekmenin ( Numune Kayıt Kabul ) B sütununa veri girişi olduğunda , kod girilen veriyi üçüncü sekmede ( Analizler ) arıyor, bulduğunda ilgili veriye ait diğer sütunlardaki bilgileri ilk sekmede yerlerine getiriyor. Ancak kod ilk sekmede girilen veriyi üçüncü sekmede bulamaz ise hata veriyor ve çalışmayı durduruyor. Bu sık yaşanabilecek bir durum olduğu için , bunu önlemenin bir yolu var mı? Veriyi eşleştiremese bile kod çalışmaya devam edebilir mi?

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    Dim No As String
    Dim Bak As Long
    Dim Target_ As Range
    Application.EnableEvents = False
    For Each Target_ In Target

        If Not Intersect(Target_, Range("B6:B" & Rows.Count)) Is Nothing Then
            If Target_.Text = "" Then
                Range("C" & Target_.Row & ":AW" & Target_.Row).ClearContents
            Else
                
                Set Bul = Worksheets("ANALİZLER").Range("B:B").Find(Target_.Text, LookAt:=xlWhole)
                If Bul Is Nothing Then
                    Range("C" & Target_.Row & ":AT" & Target_.Row) = "BULUNAMADI"
                Else
                    Cells(Target_.Row, "C") = Date
                    Cells(Target_.Row, "E") = Time
                    No = 1
                    For Bak = 7 To Cells(Rows.Count, "C").End(xlUp).Row
                        If Month(Cells(Bak, "C")) = Month(Cells(Bak - 1, "C")) Then
                            No = 1 + No
                        Else
                            No = 1
                        End If
                    Next
                    No = Right("000" & No, 4)
                    No = Format(Date, "yy") & Format(Date, "MM") & Format(Date, "dd") & No
                    Cells(Target_.Row, "F") = No
                    Worksheets("ANALİZLER").Range("F" & Bul.Row & ":AT" & Bul.Row).Copy Cells(Target_.Row, "G")
                End If
            End If
        End If
    Next
    Application.EnableEvents = True
End Sub
 

Ekli dosyalar

Üst