Excelde sütuna belirlen sayıyı atama ve toplama formülü nedir....

merhaba arkadaşlar böyle bir problemimiz var. şimdiden çözümleriniz için teşekkürler

Azizim42' Alıntı:

Kod:

Sub RastgeleDagit()
    Dim hedefToplam As Integer
    Dim satirSayisi As Integer
    Dim i As Integer, fark As Integer
 
    hedefToplam = 24
    satirSayisi = 10
 
    Dim dizi() As Integer
    ReDim dizi(1 To satirSayisi)
 
    ' İlk rastgele değerler (1–3)
    For i = 1 To satirSayisi
        dizi(i) = WorksheetFunction.RandBetween(1, 3)
    Next i
 
    ' Toplam farkını ayarla
    fark = hedefToplam - WorksheetFunction.Sum(dizi)
 
    Do While fark <> 0
        i = WorksheetFunction.RandBetween(1, satirSayisi)
        If fark > 0 And dizi(i) < 3 Then
            dizi(i) = dizi(i) + 1
            fark = fark - 1
        ElseIf fark < 0 And dizi(i) > 1 Then
            dizi(i) = dizi(i) - 1
            fark = fark + 1
        End If
    Loop
 
    ' Sonuçları F sütununa yaz
    For i = 1 To satirSayisi
        Cells(i + 1, 6).Value = dizi(i)
    Next i
End Sub

Genişletmek için tıkla ...

Teşekkürler cevabınız için. Hocam belki problemi tam anlatamadım. Toplam değer en fazla 30 olabilir. Yani sabit değil. Yani toplam değere göre (1-3) not dağılımı yapacak random. Toplam değer B12 hücresinde yazılan değer. Excel halinde olursa iyi olur. Tşkler

Sub RastgeleNotlar_Dinamik()
Dim i As Integer, toplam As Integer
Dim hedefToplam As Integer
Dim notlar(1 To 10) As Integer
Dim denemeSayisi As Long

' Hedef toplam F12 hücresinden alınır
hedefToplam = Range("F12").Value

' Eğer F12 boşsa uyarı ver
If hedefToplam = 0 Then
MsgBox "Lütfen önce F12 hücresine hedef toplam değerini yazın!", vbExclamation
Exit Sub
End If

Randomize
denemeSayisi = 0

Do
toplam = 0
denemeSayisi = denemeSayisi + 1

' 10 ders için 1-3 arası rastgele not ata
For i = 1 To 10
notlar(i) = Int(3 * Rnd) + 1
toplam = toplam + notlar(i)
Next i

' Çok uzun sürerse durdur
If denemeSayisi > 100000 Then
MsgBox "100.000 denemede toplam " & hedefToplam & " bulunamadı!", vbExclamation
Exit Sub
End If
Loop Until toplam = hedefToplam

' Hücrelere yaz
For i = 1 To 10
Range("F" & (i + 1)).Value = notlar(i)
Next i

' Toplamı tekrar hesapla
Range("F12").Value = WorksheetFunction.Sum(Range("F2:F11"))

' Bilgi mesajı
MsgBox "Toplam " & hedefToplam & " olacak şekilde notlar oluşturuldu!", vbInformation
End Sub