Dağıtma

[enjloezz]

Şu kodu kullanarak dağıtma yapıyorum ;

Sub dağıtma()
Application.ScreenUpdating = False
For i = 3 To 18
Randomize Timer
a = Rnd()
Cells(i, 1) = a
Next i
For j = 3 To 18
Cells(j, 4) = WorksheetFunction.Index([B3:B18], WorksheetFunction.Match(WorksheetFunction.Small([A3:A18], j - 2), [A3:A18], 0), 0)
Next j
[A3:A18] = ""
End Sub

fakat ben satıra 1 aşırı kaydetmesini istiyorum mesela b3e koyduysa b4e koymayacak b5e atlıcak gibisinden yardımcı olabilirmisiniz

 

[Necdet]

Merhaba,

Ne yapmak istediğinizi örnek dosyada anlatırsanız, sonuca ulaşmak daha kolay olur sanırım.

 

[enjloezz]

pardon hocam ekliyorum hemen burada b tablosundaki 1 den 16 kadar olan yeri d16ya kadar kopyalıyo fakat ben beyaz yerlerin boşluk olması istiyorum yani 1 aşırı olarak

 

[Muhammet Okumuş]

Bu kodu deneyebilirsiniz.

Sub kura()
Application.ScreenUpdating = False
Range("m3:m18") = "=rand()"
Range("m3:m18") = Range("m3:m18").Value
Range("b3:b18").Copy Range("n3")
Range("m3:n18").Sort key1:=Range("m3"), ORDER1:=xlDescending
For i = 1 To 16
Cells(2 * i + 1, 4) = Cells(i + 2, 14)
Next
Range("m3:n18") = ""
Application.CutCopyMode = False
End Sub

 

[enjloezz]

çok teşekkür ederim çalıştı fakat kodun kullanımı bilmiyorum yani değiştirmek istediğimde nasıl bişey yapmam gerekir anlatırmısınız

 

[Muhammet Okumuş]

Neyi değişitirmek istediğinizde?

 

[enjloezz]

mesela 1 yerine 2 atlama veya d yerine eye yazdırma gibisinden

 

[Muhammet Okumuş]

Sub kura()
Application.ScreenUpdating = False - ekrana işlem bittiğinde yazdırır.

Range("m3:m18") = "=rand()" -m sütunuda rastgele sayı üretir.

Range("m3:m18") = Range("m3:m18").Value - m sütununu formüllerden değere çevirir

Range("b3:b18").Copy Range("n3") ' takımları n sütununa kopyalar.
Range("m3:n18").Sort key1:=Range("m3"), ORDER1:=xlDescending ' takımları rastgele sayılara göre büyükten küçüğe sıralar

For i = 1 To 16 ' döngü 16 kez çalışır

Cells(2 * i + 1, 4) = Cells(i + 2, 14)- Cells(2 * i + 1, 4) hücresi aslında d3 hücresidir. i değeri ilkin 1 dir. 2*1+1 3 olur. 2. döngüde i=2 olur. 2*2+1= 5 olur. siz iki boşluk bırakmak isterseniz.3*i dersiniz. Cells(2 * i + 1, 4) buradaki 4 ise sütun sayısıdır. d sütunu 4. sütundur. e yapmak isterseniz 4 yerine 5 yazarsınız.
Next
Range("m3:n18") = ""
Application.CutCopyMode = False
End Sub

 

[enjloezz]

hocam çok sağolun tam istediğim gibi anlatmışsınız elleriniz dert görmesin

 

[Muhammet Okumuş]

Formülünüzü
=EĞER(YADA(D3="";D5="";E3="";E5="");"";EĞER(E3>E5;D3;D5))
bu şekilde düzenlerseniz daha güzel olur.

 

[enjloezz]

hocam bunun içinde çok teşekkürler 0 yazısı yerine yazı cıkmıyor daha güzel oldu

 

[Muhammet Okumuş]

Rica ederim. Dosyayı ona göre düzenlemiştim. Ekledim. İyi çalışmlar