Sayfa yenilenince veya F9 yapınca formüller çalışmasın.Bunun yerine buton olsun.

[yasminelt]

İki şey istiyorum:

1-Sayfa yenilenince veya F9 yapınca formüller çalışmasın.Bunun yerine buton olsun.
2-Verilen bir Tamsayı ;toplamları bu tam sayıyı verecek şekilde, 14 hücreye 0-4 arası tamsayılar şeklinde rastgele dağıtılsın. Ben bunu 7 satırlı bir formülle yapabildim. 35 öğrencili, 40 adet formdan oluşan bir çalışma kitabı, exel 2003 le 12 mb lık bir dosya boyutuna ulaşıyor.Bu formüller için makro yazılabilir mi?

Ekte örnek dosya var.Uzman Arkadaşların yardımlarını bekliyorum

 

[Korhan Ayhan]

Selamlar,

İlk sorunuz için aşağıdaki kodları dosyanıza uyarlayınız.

Boş bir modüle;

Option Explicit
 
Sub HESAPLAMA_PASİF()
    Application.Calculation = xlCalculationManual
End Sub
 
Sub HESAPLA()
    Application.Calculate
End Sub

Dosyanızın ThisWorkbook bölümüne;

Option Explicit
 
Private Sub Workbook_Activate()
    Application.Calculation = xlCalculationManual
    Application.OnKey "{F9}", "HESAPLAMA_PASİF"
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "{F9}"
End Sub
 
Private Sub Workbook_Deactivate()
    Application.OnKey "{F9}"
End Sub

Bu önerdiğim kodlar dosya açılışında hesaplama işlemini manuel olarak ayarlar. F9 tuşuna bastığınızda hesaplama yapmaz. Sadece sayfa üzerinde oluşturduğunuz butona HESAPLA isimli makroyu tanımlayıp çalıştırdığınızda hesaplama işlemini gerçekleştirir.

 

[Korhan Ayhan]

Selamlar,

İkinci sorunuz içinde aşağıdaki kodu sayfanızın kod bölümüne uygulayınız.

U4 hücresine notu girdiğinizde kod devreye girecektir. 14. satırda formülle yaptığınız işlemi kod kendisi yapacaktır. Bazı not dağılımını hesaplaması uzun sürebilir.

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("U4")) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    If Target <> Empty And IsNumeric(Target) Then
    Range("D14:Q14").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
        Range("D14:Q14") = 4
        GoTo Son
    ElseIf Target >= 95 And Target <= 97 Then
        Range("D14:Q14") = 4
10      Randomize
        SAYI = Int(Rnd * 17 + 1)
        If SAYI < 4 Then GoTo 10
        Cells(14, SAYI) = 3
        If WorksheetFunction.CountIf(Range("D14:Q14"), 3) < 2 Then
            GoTo 10
        Else
            GoTo Son
        End If
    ElseIf Target >= 98 And Target <= 99 Then
        Range("D14:Q14") = 4
20      Randomize
        SAYI = Int(Rnd * 17 + 1)
        If SAYI < 4 Then GoTo 10
        Cells(14, SAYI) = 3
        GoTo Son
    End If
    
BAŞLA:
    For X = 4 To 17
30      Randomize
        SAYI = Int(Rnd * 4 + 1)
        If (Range("U4") >= 80 And SAYI < 3) And Abs(Range("U4") - SAYI) <> 2 Then GoTo 30
        If SAYI <= 4 Then
            Cells(14, X) = SAYI
            If Range("S14") >= Range("U4") And Abs(Range("S14") - Range("U4")) <= 1 Then GoTo Son
        Else
            GoTo BAŞLA
        End If
    Next
    
    If Range("S14") <> Range("U4") Then
        Range("D14:Q14").ClearContents
        GoTo BAŞLA
    End If
    
    MsgBox "Not dağılımı tamamlanmıştır.", vbInformation
    
    Else
    
    Range("D14:Q14").ClearContents
    
    End If
Son:
    Application.ScreenUpdating = True
End Sub

 

[yasminelt]

Teşekkürler sayın korhan ayhan. İstediğim tam böyle bir şey.Ancak bir iki sorun görünüyor. Biri 60 ve altı notlarda 1 den küçük puan verilemediği için bazı hücreler boş kalıyor. Ben boş kalmasını değil de en azından 1 puan vermesini istiyorum. Diğeri ise bu kodu 30 öğrenci için nasıl yapabilirim?