• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Rastgele toplamı elle girilen sayı üretme yardım edermisiniz?

  • Konbuyu başlatan Konbuyu başlatan gergun
  • Başlangıç tarihi Başlangıç tarihi
Katılım
18 Ekim 2006
Mesajlar
22
Excel Vers. ve Dili
excell 2000 -2003
Merhaba, rastgele sayı üretme ile ilgili forumdaki tüm kodları araştırdım ve istediğime en yakın olan kodu aşağıdaki gibi buldum. ancak bu nu isteğime uyarlamak içi yardımlarınızı rica ediyorum. olması gerekenleri kodun içine yazdım

teşekkür ederim


Sub Toplam()
Döngü:
[a1:a30].ClearContents
Sat = 1
Randomize
For x = 1 To 29
Tekrar:
sayi = Int(Rnd * 30) + 1
If WorksheetFunction.CountIf(Range("a1:a" & [a65536].End(3).Row), sayi) > 0 Then GoTo Tekrar
' BEN BU RAKAMLARIN B1 HUCRESINDEN ITIBAREN Z1 HUCRESINE KADAR SOLDAN SAGA URETMESINI ISTIYORUM
Cells(Sat, "a") = sayi
Sat = Sat + 1
' BU RAKAMLARI TOPLAM 50 SATIR URETMEK VE BURADAKI GIBI TOPLAMI 400 DEGIL HER SATIRIN BASINA ELLE GIRDIGIM RAKAMA GORE URETMESINI ISTIYORUM A1=300, B1=450, C1=400 GİBİ...
If WorksheetFunction.Sum([a1:a30]) = 400 Then Exit Sub
Next
If WorksheetFunction.Sum([a1:a30]) <> 400 Then GoTo Döngü
End Sub
 
Merhaba,
Aşağıdaki kodları deneyiniz.
Sub Toplam1()
For y = 1 To 50
10
For x = 2 To 26
Randomize Timer
a = Int(Rnd() * 3 + 1)
Cells(y, x) = a
Z = WorksheetFunction.Sum(Range("b" & y & ":z" & y))
Cells(y, 27) = Z
Next x
If Cells(y, 1) <> Z Then GoTo 10
Next y
End Sub
 
Merhaba, rastgele sayı üretme ile ilgili forumdaki tüm kodları araştırdım ve istediğime en yakın olan kodu aşağıdaki gibi buldum. ancak bu nu isteğime uyarlamak içi yardımlarınızı rica ediyorum. olması gerekenleri kodun içine yazdım

teşekkür ederim

Yazarken sayın muokumus'un cevabı yoktu benimkisi alternatif olsun:)

sanırım ekteki formul işisiniz cözecektir. 1 ile 30 arasında sayı ürettiği için toplamı max 450 olabilir.


Kod:
Sub Toplam()
dgr = Range("A1").Value
Döngü:
[B1:Z1].ClearContents
sat = 1
Randomize
For x = 1 To 24
Tekrar:
sayi = Int(Rnd * 30) + 1
If WorksheetFunction.CountIf(Range(Cells(1, 2), Cells(1, x + 2)), sayi) > 0 Then GoTo Tekrar
' BEN BU RAKAMLARIN B1 HUCRESINDEN ITIBAREN Z1 HUCRESINE KADAR SOLDAN SAGA URETMESINI ISTIYORUM
Cells(1, sat + 1) = sayi
sat = sat + 1
' BU RAKAMLARI TOPLAM 50 SATIR URETMEK VE BURADAKI GIBI TOPLAMI 400 DEGIL HER SATIRIN BASINA ELLE GIRDIGIM RAKAMA GORE URETMESINI ISTIYORUM A1=300, B1=450, C1=400 GİBİ...
If WorksheetFunction.Sum([B1:Z1]) = dgr Then Exit Sub
Next
If WorksheetFunction.Sum([B1:Z1]) <> dgr Then GoTo Döngü
End Sub
 
Huseyinkis hocam merhaba,
Elinize sağlık teşekkür ederim, peki bu sayı üretmeyi 50 satırda aynı anda yapmak için döngüyü alt alta kopyalamam mı gerekir?

Muokumus hocamada ayrıca teşekkür ederim

saygılarımla
 
Huseyinkis hocam merhaba,
Elinize sağlık teşekkür ederim, peki bu sayı üretmeyi 50 satırda aynı anda yapmak için döngüyü alt alta kopyalamam mı gerekir?

Muokumus hocamada ayrıca teşekkür ederim

saygılarımla


bu işlem sadece birincü hücrede yapıyor iç içe dongu kullanılması lazım biraz uğraşayım. size dönüş yaparım.
 
İlginize çok teşekkür ederim emeginize saglık
İyi calismalar
 
İlginize çok teşekkür ederim emeginize saglık
İyi calismalar
 
Merhaba,
Aşağıdaki dosyayı inceleyiniz.
Sub üret()
Dim i As Byte
[b1:aa50] = ""
For i = 1 To 50
If Range("a" & i) = "" Then Exit Sub
Application.ScreenUpdating = False
10
Range("b" & i & ":z" & i).Formula = "=int(rand()*30+1)"
Range("b" & i & ":z" & i).Copy
Range("b" & i).PasteSpecial (xlPasteValues)
Range("aa" & i) = WorksheetFunction.Sum(Range("b" & i & ":z" & i))
If Range("a" & i) <> Range("aa" & i) Then GoTo 10
Application.CutCopyMode = False
Application.ScreenUpdating = True
Next i
End Sub
 

Ekli dosyalar

Son düzenleme:
İlginize çok teşekkür ederim emeginize saglık
İyi calismalar

Alternatif . Fakat çalışmazı uzun surebilir.
Kod:
Sub Toplam()
For i = 1 To 50
dgr = Range("A" & i).Value
Döngü:
Range("B" & i & ":Z" & i).ClearContents
sat = 1
Randomize
For x = 1 To 24
Tekrar:
sayi = Int(Rnd * 30) + 1
If WorksheetFunction.CountIf(Range(Cells(i, 2), Cells(i, x + 2)), sayi) > 0 Then GoTo Tekrar
' BEN BU RAKAMLARIN B1 HUCRESINDEN ITIBAREN Z1 HUCRESINE KADAR SOLDAN SAGA URETMESINI ISTIYORUM
Cells(i, sat + 1) = sayi
sat = sat + 1
' BU RAKAMLARI TOPLAM 50 SATIR URETMEK VE BURADAKI GIBI TOPLAMI 400 DEGIL HER SATIRIN BASINA ELLE GIRDIGIM RAKAMA GORE URETMESINI ISTIYORUM A1=300, B1=450, C1=400 GİBİ...
If WorksheetFunction.Sum(Range("B" & i & ":Z" & i)) = dgr Then GoTo son
Next
If WorksheetFunction.Sum(Range("B" & i & ":Z" & i)) <> dgr Then GoTo Döngü
son:
Next i
End Sub
 
Elinize sağlık her ikiside tam istediğim gibi. Çok teşekkür ederim

İyi çalışmalar.
 
Geri
Üst