döngüye girip donup kalma

[cerberus77]

merhaba ,

bu yapiyi calistirdigimda , excel donuyor. neden donup kaldigini anlayabilmis degilim. bu durumdan nasil kurtulurum.yardimci olursaniz sevinirim..

dosyayi da ekte gonderim.


su kodlar sayfa1 in oldugu yerde :

Private Sub Worksheet_Change(ByVal Target As Range)
If Cells(ActiveCell.Row, 1) = "ONAY" Then
Call tarih
End If
End Sub
--------------------------------------------------------------------------
bir modul olusturup su kodlari icine yazdim :

Sub tarih()

Cells(ActiveCell.Row, 2) = day(date)
Cells(ActiveCell.Row, 3) = month(date)
Cells(ActiveCell.Row, 4) = Year(Date)

End Sub

 

[ExcelF1]

Kodlarınız sonsuz döngüye neden oluyor.

Aşağıdaki gibi bir şart yapısı ile bu durumdan kurtulabilirsiniz. (Veya kendinize daha uygun bir şart oluşturun.)

Private Sub Worksheet_Change(ByVal Target As Range)
If Cells(ActiveCell.Row, 4) = Year(Date) Then Exit Sub
If Cells(ActiveCell.Row, 1) = "ONAY" Then
Call tarih
End If
End Sub

Sub tarih()
Cells(ActiveCell.Row, 2) = Day(Date)
Cells(ActiveCell.Row, 3) = Month(Date)
Cells(ActiveCell.Row, 4) = Year(Date)
End Sub

 

[ExcelF1]

Bu da alternatif olsun. Herhangi bir kod değişikliği yerine yordam değişikliği ile sorununuzu çözebilirsiniz.

Sub tarih()
Cells(ActiveCell.Row, 2) = Day(Date)
Cells(ActiveCell.Row, 3) = Month(Date)
Cells(ActiveCell.Row, 4) = Year(Date)
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Cells(ActiveCell.Row, 1) = "ONAY" Then
Call tarih
End If
End Sub

 

[cerberus77]

calistirdim tesekkur ederim

 

[ExcelF1]

Rica ederim, kolay gelsin.

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak sayfa olaylarında aşağıdaki kodda sonsuz döngüyü engeller.

Kodlarınızı ilk satırına;

Application.EnableEvents = False

Kodlarınızın bitişine;

Application.EnableEvents = True

 

[cerberus77]

) harika ! bu harika bir cozumdu .tesekkurler tekrar .

 

[stylo]

Merhabalar aşağıda kodun yazılı olduğu bir dosyam var, ancak sık sık kilitleniyor. Yardımcı olabilirmisiniz acaba?

Sub Üret()
Application.ScreenUpdating = False
Range("F4:FF103") = ""
For k = 4 To Range("D2") + 3

For j = 1 To Range("C2")
10
Randomize
x = Int(Rnd() * 9 + 1)
a = Range("B4").Offset(x, 0)
If Range("C4").Offset(x, 0) <> "" Then GoTo 10
For i = 1 To Range("C3") - 1

20
y = Int(Rnd() * 10 + 1)
b = Range("B4").Offset(y, 0)
If Range("C4").Offset(y, 0) <> "" Then GoTo 20
a = a & b

Next

süt = WorksheetFunction.Count(Range("F" & k & ":FF" & k)) + 6
adet = WorksheetFunction.CountIf(Range("F4:FF103"), a)
If adet = 1 Then GoTo 10
Cells(k, süt) = a

Next j

Next k
End Sub