Kod çalışınca dosya donuyor

[Cengizhantr06]

Dosyamda basit bir sıfırlama kodu var çalışıyor ama sayfanın birinde worksheet change olayında bi kod kullanmam gerekti o kodu oraya yazdıktan sonra sıfırlama kodu calışınca dosya donuyor
Sıfırlama kodu
Dim cevap As Variant
cevap = MsgBox("TÜM VERİLER SİLİNECEK... Onaylıyormusunuz..?", vbYesNo, "bildiri")
If cevap = vbYes Then
Sheets("10gun").Range("A5:I100000").Value = ""
Sheets("girisler").Range("A2:H100000").Value = ""
listegoster4
listegoster3
listegoster2
TextBox34.Value = ""
TextBox35.Value = ""
TextBox36.Value = ""
TextBox37.Value = ""
TextBox38.Value = ""
TextBox39.Value = ""
TextBox40.Value = ""
Else
Exit Sub
End If

Buda sayfanın worksheet change deki kodu

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Veri As Range
If Intersect(Target, Range("E2:E" & Rows.Count)) Is Nothing Then Exit Sub
For Each Veri In Intersect(Target, Range("E2:E" & Rows.Count))
If IsDate(Veri.Value) Then
Select Case Weekday(Veri.Value, vbMonday)
Case 6: Veri.Offset(0, 1) = Veri.Value + 2
Case 7: Veri.Offset(0, 1) = Veri.Value + 1
Case Else: Veri.Offset(0, 1) = Veri.Value
End Select
ElseIf Veri.Value = "" Or Not IsNumeric(Veri.Value) Then
Veri.Offset(0, 1).ClearContents
End If
Next
End Sub

 

[Zeki Gürsoy]

Change olayındaki hücre referansı değiştiğinde Change olayı tekrar tekrar tetiklenerek kısır döngüye girer. Kullanılan Change olayı 10gun veya girisler isimli çalışma sayflarının birinde ise buna benzer bir durum var. Çünkü içeriği silinen hücre aralıkları Change olayında geçen E sütünunu da kapsıyor.

Kodlamanızı buna göre revize edin.

 

[Cengizhantr06]

Change olayındaki hücre referansı değiştiğinde Change olayı tekrar tekrar tetiklenerek kısır döngüye girer. Kullanılan Change olayı 10gun veya girisler isimli çalışma sayflarının birinde ise buna benzer bir durum var. Çünkü içeriği silinen hücre aralıkları Change olayında geçen E sütünunu da kapsıyor.

Kodlamanızı buna göre revize edin.

Girişler sayfasında yardımcı olabilir misiniz Zeki Bey ?