Tekrar kodu

[hdsrny]

Merhaba Arkadaşlar aşağıda rastgele dağıtım yapan bir kod verdim..

Application.ScreenUpdating = False
Range("B2:B32") = ""
Range("GA2:GA10") = Range("A2:A10").Value
Range("GB2:GB10") = "=COUNTIF(B$2:B$32,GA2)+IF(OFFSET(B$1,COUNTA(B$2:B$32),0)=GA2,100,0)+RAND()+IF(OFFSET(E$1,MATCH(GA2,E$2:E$10,0),MATCH(GB$1,C$2:C$32,0))<>"""",1000,0)"
For i = 2 To 32
Range("GB1") = Cells(i, 3).Value
Range("GA2:GB10").Sort Range("GB2"), 1
Cells(i, 2) = Range("GA2").Value
Next
Range("GA1:HA10") = ""

Bu kod "DAĞITIM" Sayfasındaki [H10] hücresi "0"(sıfırdan) büyükse tekrarlanmasını istiyorum. Bunun için ne yapmam gerekiyor.

 

[numan şamil]

Merhaba

If Sheets("DAĞITIM").Range("H10").Value > 0 Then
Kodlar
…………..
………..
End If

Şeklinde dener misiniz.

 

[hdsrny]

Merhaba

If Sheets("DAĞITIM").Range("H10").Value > 0 Then
Kodlar
…………..
………..
End If

Şeklinde dener misiniz.

Numan Bey gönderdiğiniz kod; H10 hücresi "sıfır"dan büyükse kodları çalıştırır.
Benim istediğim H10 hücresi sıfırdan büyükse , evet hayır seçeneği ile dağıtımın tekrarlattırması.

 

[numan şamil]

Böyle bir şey mi?

Dim bak
If Sheets("DAĞITIM").Range("H10").Value > 0 Then
bak = MsgBox("H10 değeri sıfırdan büyük kodlar çalıışsın mı?", vbYesNo, "Onay")
If bak = vbNo Then Exit Sub
End If
'kodlar....

 

[hdsrny]

Hayır bundan bahsetmiyorum. Benim ilk gönderdiğim kod rastgele dağılım yapan bir kod. Butona tıkladığımda dağılım yapılıyor. Dağılım sonucunda H10 hücresi sıfırdan büyük ise (evet/hayır) evet seçeneği ile rastgele dağılımı tekrar yapmasını istiyorum.

 

[hdsrny]

Anladığım kadarıyla Do Until ... Loop Döngüsü ile yapılabilecek birşey ama nasıl yapılacağını bilmiyorum

 

[Ömer BARAN]

Afaki olarak yazışmak, fikir belirtmek yerine;
olması gereken sonuçların paralel hücrelere elle yazıldığı örnek belge yükleyerek
destek istemenizi öneriyorum.
.

 

[hdsrny]

Afaki olarak yazışmak, fikir belirtmek yerine;
olması gereken sonuçların paralel hücrelere elle yazıldığı örnek belge yükleyerek
destek istemenizi öneriyorum.
.

Henüz ALTIN ÜYELİĞİ'm olmadığından dosya yükleyemiyorum. Ama afaki yazılan bir şey değil. Yapmak istediğim kodu açıklayarak yazdım.

 

[Ömer BARAN]

Örnek dosya özellikleri ve örnek belge yükleme konusunda gerekli açıklama,
cevaplarımın altındaki İMZA bölümünde var.

 

[numan şamil]

Merhaba
Dener misiniz
Olabilir mi?

Sub dağıt()
Application.ScreenUpdating = False
Range("B2:B32") = ""
Range("GA2:GA10") = Range("A2:A10").Value
Range("GB2:GB10") = "=COUNTIF(B$2:B$32,GA2)+IF(OFFSET(B$1,COUNTA(B$2:B $32),0)=GA2,100,0)+RAND()+IF(OFFSET(E$1,MATCH(GA2, E$2:E$10,0),MATCH(GB$1,C$2:C$32,0))<>"""",1000,0)"
For i = 2 To 32
Range("GB1") = Cells(i, 3).Value
Range("GA2:GB10").Sort Range("GB2"), 1
Cells(i, 2) = Range("GA2").Value
Next
Range("GA1:HA10") = ""
Application.ScreenUpdating = True
Dim bak
Application.ScreenUpdating = False
If Sheets("DAĞITIM").Range("H10").Value > 0 Then
bak = MsgBox("H10 değeri sıfırdan büyük kodlar çalışsın mı?", vbYesNo, "Onay")
If bak = vbNo Then Exit Sub
End If
Application.ScreenUpdating = False
Range("B2:B32") = ""
Range("GA2:GA10") = Range("A2:A10").Value
Range("GB2:GB10") = "=COUNTIF(B$2:B$32,GA2)+IF(OFFSET(B$1,COUNTA(B$2:B $32),0)=GA2,100,0)+RAND()+IF(OFFSET(E$1,MATCH(GA2, E$2:E$10,0),MATCH(GB$1,C$2:C$32,0))<>"""",1000,0)"
For i = 2 To 32
Range("GB1") = Cells(i, 3).Value
Range("GA2:GB10").Sort Range("GB2"), 1
Cells(i, 2) = Range("GA2").Value
Next
Range("GA1:HA10") = ""
Application.ScreenUpdating = True
End Sub

 

[hdsrny]

Application-defined or object -defined error hatasını veriyor

 

[hdsrny]

Tamam arkadaşlar. Do Until - Loop Döngüsü ile sorunu çözdüm. İlginizden dolayı teşekkür ederim.