Şart gerçekleşene kadar makroyu devam ettirmek

[dedenet]

A1 hücresinde sayı üret fonksiyonu ile oluşturduğum değişken bir değer var.
A1 hücresindeki değer A2'den küçük olana kadar makronun tekrar etmesini istiyorum.
Aşağıdaki şekilde bir makro yazdım. ancak çalışmadı.
Yardımcı olur musunuz?

Sub Tekrar()
If [A1].Value < [A2].Value Then
Sheets("AE1").Select
Selection.ClearContents
End If
Next
End Sub

 

[ÖmerBey]

Merhaba,
Şunu deneyiniz.

Sub kod()
Do
Calculate
Loop Until Range("A1") < Range("A2")
End Sub

 

[dedenet]

Teşekkür ederim, faydalı oldu

Sub Tekrar()
Do
Calculate
Loop Until Range("AY1") < Range("AZ1")
Sheets("AE1").Select
Selection.ClearContents
End Sub

şeklinde kodu uyarladım ancak. Şart sağlandıktan sonra hata vermemesi için ne yapmalıyım.

 

[ÖmerBey]

Sayfada her değişiklik yaptığınızda formülle getirdiğiniz veri yenilenecektir. O yüzden değer değişir.
Değerin değişmemesi için şu şekilde deneyiniz.

Sub kod()
Dim s As Double
Randomize
Do
s = Rnd()
Loop Until s < Range("A2")
Range("A1") = s
End Sub

Ne yapmak istediğinizi anlattığnız bir örnek dosya paylaşırsanız daha doğru şekilde yardımcı olabiliriz.

 

[dedenet]

Farklı sınıflardan öğrenciler aynı derslikte sınava girecekler fakat aynı sınıftan öğrenciler yanyaya veya arka arkaya oturmamaları lazım.
Buna göre bir oturma düzeni ayarlamaya çalışıyorum.
Her öğrenci için sayı üret fonksiyonu ile bir sayı ürettim ve bu sayıların büyüklüğüne göre öğrenciler diziliyor.
Ama bu diziliş istediğim şekilde olmuyor. Yanyana ve arka arkaya diziliş çıkıyor. Bunun için her öğrenci için bir puanlama yaptım.
Eğer bir öğrencinin önündeki veya yanındaki öğrenci aynı sınıftan ise 1 değilse 0 şeklinde formül yazdım. Ne zamanki tüm öğrencilerin toplamı W1=0 olursa istediğim şekilde yerleştirme olmuş olacak.
Bunun olması için sayı üret fonksiyonun ürettiği değerler devamlı değişmeli (bunun için boş bir hücrede Delete tuşuna basılacak)
ve W1=0 olunca durmalı.
Yapmak istediğim olay tam olarak bu değil ama buna yakın. fikir vermesi açısından bu örneği verdim.

 

[ÖmerBey]

Tekrar merhaba,
Örnek dosyanıza göre aşağıdaki kodu kullanabilirsiniz. Bunun yanı sıra şuradaki konuyu incelemenizi tavsiye ederim. Forumda ararsanız bundan başka konular da bulabilirsiniz. İyi çalışmalar...

Sub kod2()
Dim a As Long, denemesayisi As Long
denemesayisi = 100000
Randomize
Application.ScreenUpdating = False

For a = 1 To denemesayisi
    DoEvents
    Calculate
    If Range("W1") = 0 Then
        Application.ScreenUpdating = True
        MsgBox a & " deneme sonucunda aranan değer bulundu."
        Exit Sub
    End If
Next

Application.ScreenUpdating = True
MsgBox denemesayisi & " deneme yapıldı ve sonuç bulunamadı."
End Sub

 

[dedenet]

ilginize teşekkür ederim.

Ancak şu an benim için aşağıdaki kod daha işime yarayacak.

Sub Tekrar()
Do
Calculate
Loop Until Range("AY1") < Range("AZ1")
Sheets("AE1").Select
Selection.ClearContents
End Sub

Bu koddaki sorunum şart sağlandıktan sonra yani amacıma ulaştıktan sonra

Run-time error 9
subscript out of range

şeklinde hata mesajı çıkıyor. bu hata mesajının çıkmaması için ne yapmalıyım?

 

[ÖmerBey]

Sheets("AE1").Select
Selection.ClearContents

Konunun başından beri her kodun içine yerleştirdiğiniz bu bölümün amacı nedir acaba?

 

[dedenet]

Sayı üret fonksiyonu her bir işlemde ürettiği sayıyı değiştiriyor.
ben de bunu otomatik hale getirmek için boş bir hücrede Delete tuşuna basmayı düşündüm.
sebebi budur

 

[ÖmerBey]

O zaman silin gitsin, Calculate fonksiyonu bunu yapıyor zaten.
Ayrıca Sheets("AE1") ifadesi AE1 sayfası anlamına geliyor. Dosyanızda da böyle bir sayfa olmadığı için hata oluşuyor.

 

[dedenet]

evet şimdi tam da bunu yapmıştım.
dediğiniz gibi calculate bu işi zaten yapıyor.
çok teşekkür ederim.

 

[ÖmerBey]

Rica ederim, ancak bir hususu belirtmek istiyorum: Diyelim ki; bir hata yaptınız ve yerleşmeleri asla mümkün olmayan bir grupla işlem yapmaya kalktınız. Bu durumda yazdığınız kod hiçbir zaman sonlanmayacak ve bilgisayarınızı kitleyecektir. O yüzden kodun içine bir sınır girmenizde ya da 6. mesajdaki gibi For-Next döngüsü kurmanızda fayda var.
İyi çalışmalar...