Döngünün tamamlanmaması sorunu

[bono]

Arkadaşlar ben bir okulda kullanılması için basit bir yazılım yapmaya çalıştım ancak makro dosyanın sonuna kadar çalışıyor. Ben ise işlem bittikten sonra durmasını istiyorum. Sanırım next lerde takıldım. (ekteki dosyanın içinde yazdığım makroda mevcut)

Kısaca istediğimi anlatmak istiyorum belki ilkel yollarla yaptığım bu çalışmayı daha profosyenel yapabilecek bir arkadaşım olur diye.

Okuldaki öğrencilerden ödeme yapmayanları, alınması istenen şeyleri getirmeyenleri özet tabloda döktürmek istiyorum.

Tabloda LİSTE adında bir sheet var. Oraya ne kadar ödeme istendiği, nelerin alınması istendiği gibi bilgileri düşüyorum ve ÖDEMELER sheetinde ödemeyi eksik yapanların veya yapmayanların kayıtlarını tutmaya çalışıyorum. (Formüller aracılığı ile bunu yan kolonlarda yapmaya çalıştım)

Yine ALINANLAR sheetinde de alınması istenmiş ama alınmamışların listesini tutmaya çalışıyroum. Bunuda formüllerle yapmaya çalıştım.

Özet tablodaki AKTAR butonuna basınca iki sheette arama yapıp bana ödemeyi eksik yapan veya yapmayanların, getirilmesi gerekenleri getirmeyenleri listelemeye çalışıyorum. Ancak bir kişinin ismi bir kez geçmeli.

Belki bununla ilgili daha güzel bir kurguda yapılabilir ama en acil olanı şu anda benim yaptığım makroyu yerinde durdurabilmek

teşekkürler

 

[bono]

Arkadaşlar makrosunu aşağıya kopyaladım. Daha iyi bir makroyu bıraktım bir yere, bu döngüyü sonlandıracak next i nasıl kullanabilirim yardımcı olursanız sevinirim.

Teşekküler.

Sub listele()

Dim sat As Integer


Set s1 = Sheets("ÖZET TABLO")
Set S2 = Sheets("ÖDEMELER")
Set s3 = Sheets("ALINANLAR")

s1.[A2:A5000] = ""

S = 2
For sat = 2 To S2.Cells(65536, "AD").End(xlUp).Row
If S2.Cells(sat, "AD") < 0 Then
s1.Cells(S, "A") = S2.Cells(sat, "b").Value
s1.Cells(S, "b") = S2.Cells(sat, "ad").Value
S = S + 1
End If

Next

sat1 = s1.Cells(65536, 1).End(xlUp).Row
sat2 = s3.Cells(200, 1).End(xlUp).Row

S4 = 2
For a = 2 To sat1
For b = 1 To sat2
'For c = 2 To s3.Cells(65536, "AU").End(xlUp).Row
If (s1.Cells(a, 1) = s3.Cells(b + 1, 2).Value) And (s3.Cells(sat, "AU") <> ",,,,,,,,,,,,,,,,,,,") Then

s1.Cells(a, 3) = s3.Cells(b + 1, 47).Value

Else

'If (s1.Cells(a, 1) <> s3.Cells(b + 1, 2).Value) And (s3.Cells(sat, "AU") <> ",,,,,,,,,,,,,,,,,,,") Then

s1.Cells(S4, "A") = s3.Cells(b, "b").Value
s1.Cells(S4, "c") = s3.Cells(b, "au").Value
S4 = S4 + 1
End If

Next b
Next a

End Sub

 

[bono]

Bu işi bilen bir arkadaşımın en azından döngüyü durdurmak için ne yapmam gerektiğini söylemesi iki gündür girdiğim eziyetten beni kurtarırdı. Çokmu karışık yazdığım makro bilmiyorum ama düzeltmede yardım ederseniz gerçekten büyük iyilik yapmış olacaksınız.

 

[bono]

üstadalar bu kadar vahimmi yazdığım makronun durumu en azından onu söyleyin boşuna deliler gibi orasını burasını değiştirmeye çalışıyorum. bu kadaranıda zaten sizlerin yazdıklarınızdan toplamaya çalışmıştım ama başarılı olamadım.