- 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?
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
-
1.8 MB Görüntüleme: 3