=Rastgelearada

T

tiwamo

Katılım
30 Mayıs 2015
Mesajlar
27
Excel Vers. ve Dili
2016 Türkçe
A B C D E
1 30 30 20 20 100
2 ? ? ? ? 80
3

Arkadaşlar,

Şöyle bir problemim var. Çözüme yardımcı olursanız sevineceğim.

A-D sütunlarının 2. sırasındaki rakamlar toplamı 100 olacak şekilde değişebilecek

sabit sayılardır. Ve aynı zamanda altlarındaki sayıların =RASTGELEARADA

üstsınırıdır.

Sorun şu: Diyelim ki, E sütunundaki 100'ün altına 80 yazdığımda soldaki 4 rakamın

toplamı 80, üst sınırları 2. sıradaki rakamlar olacak şekilde değişmesini nasıl

sağlayabilirim? (Sütunlar en çok 10, satırlar 40 olacaktır.)

Bir de =RASTGELEARADA fonksiyonu geçici sonuç veriyor. Böyle olmamalı.

Bulunan sonuçlar asla değişmemeli.

Fonksiyon ve makrolu çözümlere açığım. Yardımlarınız için şimdiden çok teşekkürler.
 
T

tiwamo

Katılım
30 Mayıs 2015
Mesajlar
27
Excel Vers. ve Dili
2016 Türkçe
Sayın Korhan Bey,

Önerdiğiniz dosya"RNEKxlsm.zip" olarak inidi. Onun içinden "RNEKxlsm__11652_il78313.exe_installer.zip" dosyası, ondan da "RNEKxlsm__11652_il78313.exe" çıktı.

Onu çalıştırmamla film koptu. Pc’mde not defteri dâhil hiç bir programı çalıştıramaz oldum. Ve ancak formatla yeniden hayata dönebildim.

Teknik konulardan pek anlamam ama bir virüs taraması yapsanız fena olmaz gibi geliyor bana. Dosyayı da değiştirirseniz en azından benim başıma gelen başka arkadaşların başına gelmez!

Excel problemimse hâlâ duruyor. ;)
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,202
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bilgisayarınıza zarar verdiğim için özür dilerim. Ama biraz önce kendim denedim hiç bir sorunla karşılaşmadım. İlgili linke tıkladığınızda iki adet İNDİR butonu görünüyor. En yukardaki sponsor linkidir. Acaba buna tıklamış olabilir misiniz?

Biraz altında ise normal indirme butonu görünüyor. Ona tıkladığınızda normal indirmesi gerekiyor.

Neyse ben uyarınız üzerine linki kaldırdım.

Yeni link aşağıdadır.

Örnek Dosya
 
T

tiwamo

Katılım
30 Mayıs 2015
Mesajlar
27
Excel Vers. ve Dili
2016 Türkçe
Üst linke tıklasam o dosya inmezdi ki zaten. Neyse... Belki yolda bulaşmıştır. Önemli değil. Bu ayki beşinci formatımdı zaten.

Yeni dosya sorunsuz indi. Elinize sağlık. Yeni açıklamaları yazıp tekrar gönderiyorum. Biraz daha uğraştıracağım sizi. Kusura bakmayın.

https://yadi.sk/i/I_u4xd8Pgye4B
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,202
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Eski kodları silip aşağıdaki kodu deneyin.

5 ve 10 sütunluk dağılımlar için kod değiştirmek gerekir. Şu haliyle 6 sütun için dağılım yapmaktadır.

Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
 
    If Intersect(Target, Range("D4:D65536")) Is Nothing Then Exit Sub
    Range("F" & Target.Row & ":K" & 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("F" & Target.Row & ":K" & Target.Row).Value = Range("F2:K2").Value
            Case 7 To 99
                Range("F" & Target.Row) = "=RANDBETWEEN(1,F2)"
                Range("G" & Target.Row) = "=RANDBETWEEN(1,G2)"
                Range("H" & Target.Row) = "=RANDBETWEEN(1,H2)"
                Range("I" & Target.Row) = "=RANDBETWEEN(1,I2)"
                Range("J" & Target.Row) = "=RANDBETWEEN(1,J2)"
                Range("K" & Target.Row) = "=RANDBETWEEN(1,K2)"
            Case Is = 6
                Range("F" & Target.Row & ":K" & Target.Row) = 1
            Case Is < 6
                MsgBox "6 dan 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("F" & Target.Row & ":K" & Target.Row)) <> Target Then
            GoTo 10
        Else
            Range("F" & Target.Row & ":K" & Target.Row).Value = Range("F" & Target.Row & ":K" & Target.Row).Value
        End If
        MsgBox "Not dağılımı tamamlanmıştır.", vbInformation
    End If
 
Son:
    Application.ScreenUpdating = True
End Sub
 
T

tiwamo

Katılım
30 Mayıs 2015
Mesajlar
27
Excel Vers. ve Dili
2016 Türkçe
şimdi oldu!!!

çok çok çok çok teşekkür ederim.

Allah ne muradınız varsa versin. Elleriniz dert görmesin.

5 ve 10 sütunluklara daha sonra bakarım artık.
 
Son düzenleme:
T

tiwamo

Katılım
30 Mayıs 2015
Mesajlar
27
Excel Vers. ve Dili
2016 Türkçe
Korhan Bey,

Bir problem daha çıktı.

Ekteki tabloda "D" sütununa rakamların topluca girilmesi gerekiyor. Yani başka bir tablodan notların yazıldığı sütundan kopyalamak suretiyle alınan rakamların bu tablonun "D" sütununa yapıştırılması, bilahare "F-K" sütunlarında ilgili hücrelere rakamların excel tarafından (önceki şartlara uygun olarak) dağıtılması mümkün mü?

https://yadi.sk/i/-VdxXQwLh3MnH
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,202
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki kodu deneyiniz.

Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range, Alan As Range, Say As Variant
    
    On Error GoTo Son
 
    Set Alan = Range("D4:D65536")
 
    If Intersect(Target, Alan) Is Nothing Then Exit Sub
 
    Application.ScreenUpdating = False
 
    If Val(Application.Version) > 11 Then
        Say = Target.Cells.CountLarge
    Else
        Say = Target.Cells.Count
    End If
 
    If Say = 1 Then
        Range("F" & Target.Row & ":K" & Target.Row).ClearContents
        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("F" & Target.Row & ":K" & Target.Row).Value = Range("F2:K2").Value
                Case 7 To 99
                    Range("F" & Target.Row) = "=RANDBETWEEN(1,F2)"
                    Range("G" & Target.Row) = "=RANDBETWEEN(1,G2)"
                    Range("H" & Target.Row) = "=RANDBETWEEN(1,H2)"
                    Range("I" & Target.Row) = "=RANDBETWEEN(1,I2)"
                    Range("J" & Target.Row) = "=RANDBETWEEN(1,J2)"
                    Range("K" & Target.Row) = "=RANDBETWEEN(1,K2)"
                Case Is = 6
                    Range("F" & Target.Row & ":K" & Target.Row) = 1
                Case Is < 6
                    MsgBox "6 dan 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("F" & Target.Row & ":K" & Target.Row)) <> Target Then
                GoTo 10
            Else
                Range("F" & Target.Row & ":K" & Target.Row).Value = Range("F" & Target.Row & ":K" & Target.Row).Value
            End If
            MsgBox "Not dağılımı tamamlanmıştır.", vbInformation
        End If
    
    Else
 
        For Each Veri In Selection
            If Not Intersect(Veri, Alan) Is Nothing Then
                If Veri <> Empty And IsNumeric(Veri) Then
20                  Select Case Veri
                        Case Is > 100
                            MsgBox "100 den büyük değer girdiniz !" & Chr(10) & "İşleminiz iptal edilmiştir !", vbCritical, "Dikkat !"
                            Veri.ClearContents
                            Veri.Select
                            GoTo Son
                        Case 100
                            Range("F" & Veri.Row & ":K" & Veri.Row).Value = Range("F2:K2").Value
                        Case 7 To 99
                            Range("F" & Veri.Row) = "=RANDBETWEEN(1,F2)"
                            Range("G" & Veri.Row) = "=RANDBETWEEN(1,G2)"
                            Range("H" & Veri.Row) = "=RANDBETWEEN(1,H2)"
                            Range("I" & Veri.Row) = "=RANDBETWEEN(1,I2)"
                            Range("J" & Veri.Row) = "=RANDBETWEEN(1,J2)"
                            Range("K" & Veri.Row) = "=RANDBETWEEN(1,K2)"
                        Case Is = 6
                            Range("F" & Veri.Row & ":K" & Veri.Row) = 1
                        Case Is < 6
                            MsgBox "6 dan küçük değer girdiniz !" & Chr(10) & "İşleminiz iptal edilmiştir !", vbCritical, "Dikkat !"
                            Veri.ClearContents
                            Veri.Select
                            GoTo Son
                    End Select
                
                    If WorksheetFunction.Sum(Range("F" & Veri.Row & ":K" & Veri.Row)) <> Veri Then
                        GoTo 20
                    Else
                        Range("F" & Veri.Row & ":K" & Veri.Row).Value = Range("F" & Veri.Row & ":K" & Veri.Row).Value
                    End If
                End If
            End If
        Next
        
        MsgBox "Not dağılımı tamamlanmıştır.", vbInformation
    End If

Son:
    Application.ScreenUpdating = True
End Sub
 
T

tiwamo

Katılım
30 Mayıs 2015
Mesajlar
27
Excel Vers. ve Dili
2016 Türkçe
Denedim... Ama 40 öğrnci için. sonucu almam 52 dakika sürdü, :( ve bu arada PC'de başka işlem yapamadım. 6 sınıf olduğunu düşünün.
Daha kısa bir yolu olmalı bunun.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,202
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki kodu deneyin.

30-70 saniye arasında sonuç alabildim. Not değerlerine göre süre uzayıp kısalabilir.

Ayrıca kod içindeki kırılımlarla oynayarak kendinize göre ayarlamalar yapabilirisiniz.

Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range, Alan As Range, Say As Variant, Zaman As Double
    
    Zaman = Timer
    
    On Error GoTo Son
 
    Set Alan = Range("D4:D65536")
 
    If Intersect(Target, Alan) Is Nothing Then Exit Sub
 
    Application.ScreenUpdating = False
 
    If Val(Application.Version) > 11 Then
        Say = Target.Cells.CountLarge
    Else
        Say = Target.Cells.Count
    End If
 
    If Say = 1 Then
        Range("F" & Target.Row & ":K" & Target.Row).ClearContents
        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("F" & Target.Row & ":K" & Target.Row).Value = Range("F2:K2").Value
                Case 70 To 99
                    Range("F" & Target.Row) = "=RANDBETWEEN(10,F2)"
                    Range("G" & Target.Row) = "=RANDBETWEEN(10,G2)"
                    Range("H" & Target.Row) = "=RANDBETWEEN(5,H2)"
                    Range("I" & Target.Row) = "=RANDBETWEEN(5,I2)"
                    Range("J" & Target.Row) = "=RANDBETWEEN(5,J2)"
                    Range("K" & Target.Row) = "=RANDBETWEEN(5,K2)"
                Case 40 To 69
                    Range("F" & Target.Row) = "=RANDBETWEEN(5,F2)"
                    Range("G" & Target.Row) = "=RANDBETWEEN(5,G2)"
                    Range("H" & Target.Row) = "=RANDBETWEEN(5,H2)"
                    Range("I" & Target.Row) = "=RANDBETWEEN(5,I2)"
                    Range("J" & Target.Row) = "=RANDBETWEEN(5,J2)"
                    Range("K" & Target.Row) = "=RANDBETWEEN(5,K2)"
                Case 20 To 39
                    Range("F" & Target.Row) = "=RANDBETWEEN(1,F2)"
                    Range("G" & Target.Row) = "=RANDBETWEEN(1,G2)"
                    Range("H" & Target.Row) = "=RANDBETWEEN(1,H2)"
                    Range("I" & Target.Row) = "=RANDBETWEEN(1,I2)"
                    Range("J" & Target.Row) = "=RANDBETWEEN(1,J2)"
                    Range("K" & Target.Row) = "=RANDBETWEEN(1,K2)"
                Case 7 To 19
                    Range("F" & Target.Row) = "=RANDBETWEEN(1,5)"
                    Range("G" & Target.Row) = "=RANDBETWEEN(1,5)"
                    Range("H" & Target.Row) = "=RANDBETWEEN(1,5)"
                    Range("I" & Target.Row) = "=RANDBETWEEN(1,5)"
                    Range("J" & Target.Row) = "=RANDBETWEEN(1,5)"
                    Range("K" & Target.Row) = "=RANDBETWEEN(1,5)"
                Case Is = 6
                    Range("F" & Target.Row & ":K" & Target.Row) = 1
                Case Is < 6
                    MsgBox "6 dan 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("F" & Target.Row & ":K" & Target.Row)) <> Target Then
                GoTo 10
            Else
                Range("F" & Target.Row & ":K" & Target.Row).Value = Range("F" & Target.Row & ":K" & Target.Row).Value
            End If
            MsgBox "Not dağılımı tamamlanmıştır.", vbInformation
        End If
    
    Else
 
        For Each Veri In Selection
            If Not Intersect(Veri, Alan) Is Nothing Then
                If Veri <> Empty And IsNumeric(Veri) Then
20                  Select Case Veri
                        Case Is > 100
                            MsgBox "100 den büyük değer girdiniz !" & Chr(10) & "İşleminiz iptal edilmiştir !", vbCritical, "Dikkat !"
                            Veri.ClearContents
                            Veri.Select
                            GoTo Son
                        Case 100
                            Range("F" & Veri.Row & ":K" & Veri.Row).Value = Range("F2:K2").Value
                        Case 70 To 99
                            Range("F" & Veri.Row) = "=RANDBETWEEN(10,F2)"
                            Range("G" & Veri.Row) = "=RANDBETWEEN(10,G2)"
                            Range("H" & Veri.Row) = "=RANDBETWEEN(5,H2)"
                            Range("I" & Veri.Row) = "=RANDBETWEEN(5,I2)"
                            Range("J" & Veri.Row) = "=RANDBETWEEN(5,J2)"
                            Range("K" & Veri.Row) = "=RANDBETWEEN(5,K2)"
                        Case 40 To 69
                            Range("F" & Veri.Row) = "=RANDBETWEEN(5,F2)"
                            Range("G" & Veri.Row) = "=RANDBETWEEN(5,G2)"
                            Range("H" & Veri.Row) = "=RANDBETWEEN(5,H2)"
                            Range("I" & Veri.Row) = "=RANDBETWEEN(5,I2)"
                            Range("J" & Veri.Row) = "=RANDBETWEEN(5,J2)"
                            Range("K" & Veri.Row) = "=RANDBETWEEN(5,K2)"
                        Case 20 To 39
                            Range("F" & Veri.Row) = "=RANDBETWEEN(1,F2)"
                            Range("G" & Veri.Row) = "=RANDBETWEEN(1,G2)"
                            Range("H" & Veri.Row) = "=RANDBETWEEN(1,H2)"
                            Range("I" & Veri.Row) = "=RANDBETWEEN(1,I2)"
                            Range("J" & Veri.Row) = "=RANDBETWEEN(1,J2)"
                            Range("K" & Veri.Row) = "=RANDBETWEEN(1,K2)"
                        Case 7 To 19
                            Range("F" & Veri.Row) = "=RANDBETWEEN(1,5)"
                            Range("G" & Veri.Row) = "=RANDBETWEEN(1,5)"
                            Range("H" & Veri.Row) = "=RANDBETWEEN(1,5)"
                            Range("I" & Veri.Row) = "=RANDBETWEEN(1,5)"
                            Range("J" & Veri.Row) = "=RANDBETWEEN(1,5)"
                            Range("K" & Veri.Row) = "=RANDBETWEEN(1,5)"
                        Case Is = 6
                            Range("F" & Veri.Row & ":K" & Veri.Row) = 1
                        Case Is < 6
                            MsgBox "6 dan küçük değer girdiniz !" & Chr(10) & "İşleminiz iptal edilmiştir !", vbCritical, "Dikkat !"
                            Veri.ClearContents
                            Veri.Select
                            GoTo Son
                    End Select
                
                    If WorksheetFunction.Sum(Range("F" & Veri.Row & ":K" & Veri.Row)) <> Veri Then
                        GoTo 20
                    Else
                        Range("F" & Veri.Row & ":K" & Veri.Row).Value = Range("F" & Veri.Row & ":K" & Veri.Row).Value
                    End If
                End If
            End If
        Next
        
        MsgBox "Not dağılımı tamamlanmıştır." & Chr(10) & "İşlem süresi ; " & Format(Timer - Zaman, "0.00"), vbInformation
    End If

Son:
    Application.ScreenUpdating = True
End Sub
 
T

tiwamo

Katılım
30 Mayıs 2015
Mesajlar
27
Excel Vers. ve Dili
2016 Türkçe
Çooook teşekkürler. Bu defa oldu galiba,. 36 saniye yazdı. Süper..
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst