Bir sayının toplamı olan rakamları bulma

[qazqaz1111112]

"satırdaki 7 yi düşük bir değer yapınca hızlı atıyor ama snuç tutmuyor malesef..."
sayın birey111 ben bunuda denedim hatta 7 den büyükleri ve küçükleride defalarca... Kesinlikle sonuç tutmuyor. Acil yardımmm

 

[qazqaz1111112]

Lütfen yardım...

 

[qazqaz1111112]

arkadaşlar yardım edin lütfen...

 

[Korhan Ayhan]

Merhaba,

Önermiş olduğum kod rastgele sayılar üretmektedir. Kodun daha hızlı çalışması için bazı kriterler eklemek ve kodun çalışma aralığını daraltmak gerekiyor.

Ekteki örnek dosyada bazı kriterler ekleyerek kodun daha hızlı çalışmasını sağladım. İncelermisiniz.

 

[qazqaz1111112]

Sayın Korhan Ayhan beyefendi, öncelikle ellerinize sağlık ama 90-99 arası not verince yine donuyor.Lütfen çözüme bu kadar yaklaşmışken bir daha denermisiniz...yardımlarınıza ihtiyacım var lütfen yardım...

 

[qazqaz1111112]

"kodun çalışma aralığını daraltmak gerekiyor." demişsiniz bunu da söyleseniz belki bende yapabilirim.Hala çalışıyorum bu dosyanın üzerinde acil yardım korhan bey...

 

[qazqaz1111112]

yardım edin lütfen arkadaşlar

 

[birey111]

Mutlaka senin Ölçeği mi kullanman gerekiyor. Ben bir şekilde aşağıdaki ölçekte yaptım. İstersen bunu kullan....Neticede buda performans değerlendirme ölçeği...80-100 arası kasmıyor...

 

[qazqaz1111112]

sayın birey111 ilginize sonsuz teşekkürler ama benim krtiterlerim buna uymuyor.Eğer uydurabilsem inanın hiç uğraşmazdım lütfen yardım...

 

[birey111]

oradaki if leri kullan .... Hem hızlanıyor hem de kesin sonuç. Biraz yazması zahmetli ama sonuçta iş görüyor...

 

[Korhan Ayhan]

Merhaba,

Biraz daha hızlı olsun diye sayı aralıklarını iyice daralttım. Yavaş çalıştığını düşündüğünüz aralıklar varsa kendinize göre ayarlarsınız.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
 
    If Intersect(Target, Range("I3:I65536")) Is Nothing Then Exit Sub
    Range("B" & Target.Row & ":H" & Target.Row).ClearContents
 
    Application.ScreenUpdating = False
 
    If Target <> Empty And IsNumeric(Target) Then
10      Select Case Target
            Case Is > 100
                MsgBox "100 den büyük değer girdiniz !" & Chr(10) & "İşleminiz iptal edilmiştir !", vbCritical, "Dikkat !"
                Target.ClearContents
                Target.Select
                GoTo Son
            Case 100
                Range("B" & Target.Row & ":H" & Target.Row).Value = Range("B1:H1").Value
            Case 70 To 99
                Range("B" & Target.Row & ":H" & Target.Row) = "=RANDBETWEEN(10,B1)"
            Case 40 To 69
                Range("B" & Target.Row & ":H" & Target.Row) = "=RANDBETWEEN(5,10)"
            Case 20 To 39
                Range("B" & Target.Row & ":H" & Target.Row) = "=RANDBETWEEN(1,10)"
            Case 8 To 19
                Range("B" & Target.Row & ":H" & Target.Row) = "=RANDBETWEEN(1,5)"
            Case Is = 7
                Range("B" & Target.Row & ":H" & Target.Row) = 1
            Case Is < 7
                MsgBox "7 den küçük değer girdiniz !" & Chr(10) & "İşleminiz iptal edilmiştir !", vbCritical, "Dikkat !"
                Target.ClearContents
                Target.Select
                GoTo Son
        End Select
 
        If WorksheetFunction.Sum(Range("B" & Target.Row & ":H" & Target.Row)) <> Target Then
            GoTo 10
        Else
            Range("B" & Target.Row & ":H" & Target.Row).Value = Range("B" & Target.Row & ":H" & Target.Row).Value
        End If
        MsgBox "Not dağılımı tamamlanmıştır.", vbInformation
    End If
 
Son:
    Application.ScreenUpdating = True
End Sub

 

[qazqaz1111112]

sayın Korhan Ayhan beyefendi şu an size ne kadar teşekkür etsem yine de azdır.İstediğim olmuş durumda.Ellerinize, beyninize, yüreğinize sağlık çok çok çok TEŞEKKÜR EDERİM.....

 

[birey111]

bende #AD? hatası veriyor?

 

[Korhan Ayhan]

Merhaba,

Kodların çalışması için aşağıdaki işlemi uygulayın.

Araçlar-Eklentiler-ToolPak VBA Çözümleyici seçeneğini aktif hale getirin.

bende #AD? hatası veriyor?