Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: birey112 - 18 Ocak 2012, 23:46:28

Başlık: rastgele sayıları toplama
Gönderen: birey112 - 18 Ocak 2012, 23:46:28

aşağıdaki kodlar yazılan sayıya göre rastgele sayılar oluşturup topluyor,

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SAYI As Byte, X As Byte
   
    On Error GoTo Son
   
    If Intersect(Target, Range("X3:X65536")) Is Nothing Then Exit Sub
   
    Application.ScreenUpdating = False
   
    If Target <> Empty And IsNumeric(Target) Then
    Range("D" & Target.Row & ":W" & Target.Row).ClearContents

    If Target > 100 Then
        MsgBox "100 den büyük değer girdiniz !" & Chr(10) & "İşleminiz iptal edilmiştir !", vbCritical, "Dikkat !"
        Target.ClearContents
        Target.Select
        GoTo Son
        Exit Sub
    End If

    If Target = 100 Then
        For X = 4 To 23
            Cells(Target.Row, X) = Cells(1, X)
        Next
        GoTo Son
    End If
   

    BAŞLA:
    Randomize
    SAYI = Int(Rnd * 5 + 1)
    For X = 4 To 23
        If Cells(Target.Row, X) = Empty Then
            If SAYI <= Cells(1, X) Then
                If WorksheetFunction.Sum(Range("D" & Target.Row & ":W" & Target.Row)) <= Target Then
                    Cells(Target.Row, X) = SAYI
                    GoTo BAŞLA
                End If
            Else
                GoTo BAŞLA
            End If
        End If
    Next
   
    If WorksheetFunction.CountA(Range("D" & Target.Row & ":W" & Target.Row)) <= 20 And _
    WorksheetFunction.Sum(Range("D" & Target.Row & ":W" & Target.Row)) <> Target Then
    Range("D" & Target.Row & ":W" & Target.Row).ClearContents
    GoTo BAŞLA
    End If
   
    MsgBox "Not dağılımı tamamlanmıştır.", vbInformation
   
    Else
   
    Range("D" & Target.Row & ":W" & Target.Row).ClearContents
   
    End If

Son:
    Application.ScreenUpdating = True
End Sub


sorun şu 80 ekadar iyi ,80 den sonra kitliyor yada sadece bekliyor.
bunu nasıl çözebiliriz?

ben şöyle bir şey düşündüm;

If Target = 100 Then
        For X = 4 To 23
            Cells(Target.Row, X) = Cells(1, X)
        Next
        GoTo Son
    End If

burada 100 olursa tüm hepsini 5 dolduruyor
For X = 4 To 22
yaparsan son sütunu (W) boş bırakıyor,
buraya w sütununa 4 nasıl ekletiriz?

bu işlemi geriye doğru sıra ile yapmayı düşünüyorum, yani 21,20 diye 80 e kadar gidecem
her formülde sonda kalan hücrelere 4 atayacak . Bilmeme anlatabildim mi?
yardım ederseniz sevinirim.