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

sangelosa · 8 Haziran 2010

Değerli arkadaşlar,
ben İstanbul'da çalışan bir müzik öğretmeniyim.
Malum müzik öğretmeni olduğumdan matematiğim iyi değil,
excel'de basit formülleri yapabiliyorum ancak bu yıl sonunda bir formüle ya da öneriye ihtiyacım oldu,işin içinden çıkamadım.

Tam olarak şöyle bir sorunum var.

100'e kadar herhangi bir sayı yazdığımda excel bu sayının belirli şartlara bağlı ondalıksız toplamı olabilecek örneğin 8 sayı üretip hücrelere yazdırsın istiyorum.

Örneğin ben J5 hücresine 90 yazdım ,
bu doksan sayısının toplamı olabilecek 8 adet rakam bana otomatik üretsin istiyorum.Bu üretilecek sayılar için de en fazla olabilecek sayısal baraj olmalı,aşağıdaki örnekte o nedenle bir kriterin en fazla kaç puan olabileceğini yanına yazdım.
Bu mümkün mü gerçekten bilmiyorum, çok uğraştım ama kafam şişti,matematiğim maalesef iyi değil.

Örnek :

B5 hücresi 20 (Ödevi Zamanında Getirme) 20 Puan
C5 Hücresi 10 (Genel Düzen ve Materyal Hazırlama) 10 Puan
D5 Hücresi 10 (Araştırma ve Elde Edilen Bilgi Yeterliliği) 20 Puan
E5 Hücresi 10 (Ses Pozisyonlarına Hakimiyet) 10
F5 Hücresi 10 (Yapabileceğinin farkında olma ve ek çaba) 10
G5 Hücresi 10 (Sonuna kadar devam edebilme) 10
H5 Hücresi 10 (Türkçe'yi düzgün kullanma) 10
I5 Hücresi 10 (Yazı dışındaki Görsel-medyatik Materyaller) 10

Toplam = 90 (J5 Hücresine ben 90 yazdığımda B-C-D-E-F-G-H-I5 hğcrelerine otomatik (her hücre için en fazla puan şartına bağlı) puanlama yazdırılsın , hesaplanıp gösterilsin istiyorum.

Bu tür bir çalışma ya da excel belgesi mümkün müdür yoksa mümkünd eğil mi, bana yardımcı olursanız çok sevinirim değerli arkadaşlar.

Saygılarımla

Korhan Ayhan · 8 Haziran 2010

Selamlar,

Konuyla ilgili örnek dosya eklermisiniz. Ayrıca sayısal barajdan bahsetmişsiniz. Fakat bir tek D5 hücresinin sınırı (10-20) birbirini tutmuyor. Sanıyorum tüm olay bu hücredeki sınıra göre belirlenecek.

sangelosa · 8 Haziran 2010

Üstadım örnek dosya ekleyemedim çünkü ben beceremedim bunu yapabilmeyi.
Baraj derken en fazla bir hücreye verebileceği sayı açısından düşünmüştüm.

Örnekteki öğrenci yüz üzerinden 90 almış, o nedenle 20 puanlık bölümden 10 puan eksik almış.
Bu diğer hücrelere dağıtılarak da olabilirdi.
Örneğin ;

B5 hücresi 15 (Ödevi Zamanında Getirme) 20 Puan
C5 Hücresi 10 (Genel Düzen ve Materyal Hazırlama) 10 Puan
D5 Hücresi 15 (Araştırma ve Elde Edilen Bilgi Yeterliliği) 20 Puan
E5 Hücresi 5 (Ses Pozisyonlarına Hakimiyet) 10
F5 Hücresi 10 (Yapabileceğinin farkında olma ve ek çaba) 10
G5 Hücresi 5 (Sonuna kadar devam edebilme) 10
H5 Hücresi 10 (Türkçe'yi düzgün kullanma) 10
I5 Hücresi 10 (Yazı dışındaki Görsel-medyatik Materyaller) 10

Toplam öğrenci 80 puan almış da olabilirdi. (Not aldığı her ne ise, ödev ya da başka bir çalışma)
Yani ben 80 yazınca böyle dağıtmalı(her hücre için en fazla puanlama sınır aşılmamalı).Dağıtırken adı geçen her bir hücreye verebileceği en fazla puandan bahsetmek istemiştim.
Rasgele dağıtabilir elbette ancak barajları geçmemesi gerekiyor teknik açıdan.
Ben çok anlamadığım için matematikten şartı ifade ederken yanlış anlatmış olabilirim kusura bakmayın

Ergün Güler · 8 Haziran 2010

sangelosa' Alıntı:
Üstadım örnek dosya ekleyemedim çünkü ben beceremedim bunu yapabilmeyi.

Selam,
1.mesajınıza gidiyorsunuz altta, sağda "Düzelt" butonuna tıklıyorsunuz. daha sonra "Gelişmiş mod"a tıklıyorsunuz. aşağıya doğru iniyorsunuz. "Dosya ekle"ye tıklayıp dosyanızı bulunduğu klasörden yüklüyorsunuz.
Size yardımcı olacaklara sizin de yardımcı olmanız lazım. Bu sayede daha hızlı, iyi çözümlere ulaşırsınız.
İyi çalışmalar.

sangelosa · 8 Haziran 2010

Yaf ben dosya eklemeyi bilmiyorum demek istemedim

Ben ilgili konuyu içerecek bir formül vs düzenleyemedim demek istedim.
Ancak formülsüz boş hali ile bir dosya göndereyim bari

Çok teşekkür ederim ilgilendiğiniz için ayrıca.

Korhan Ayhan · 9 Haziran 2010

Selamlar,

Aşağıdaki kodu Sayfa1 in kod bölümüne uygulayıp denermisiniz.

Kod:

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("H3:H65536")) Is Nothing Then Exit Sub
 
    Application.ScreenUpdating = False
 
    If Target <> Empty And IsNumeric(Target) Then
    Range("B" & Target.Row & ":G" & 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 = 2 To 7
            Cells(Target.Row, X) = Cells(1, X)
        Next
        GoTo Son
    End If
 
BAŞLA:
    Randomize
    SAYI = Int(Rnd * 20 + 1)
    For X = 2 To 7
        If Cells(Target.Row, X) = Empty Then
            If SAYI <= Cells(1, X) Then
                If WorksheetFunction.Sum(Range("B" & Target.Row & ":G" & 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("B" & Target.Row & ":G" & Target.Row)) <= 6 And _
    WorksheetFunction.Sum(Range("B" & Target.Row & ":G" & Target.Row)) <> Target Then
    Range("B" & Target.Row & ":G" & Target.Row).ClearContents
    GoTo BAŞLA
    End If
 
    MsgBox "Not dağılımı tamamlanmıştır.", vbInformation
 
    Else
 
    Range("B" & Target.Row & ":G" & Target.Row).ClearContents
 
    End If
 
Son:
    Application.ScreenUpdating = True
End Sub

sangelosa · 9 Haziran 2010

Çok teşekkür ederim,
çizelgeyi büyüterek bir sınıfa uyarlamaya çalışacağım.

Emeğinize sağlık.
Saygılar.

sangelosa · 9 Haziran 2010

99'a kadar çok düzgün çalışıyor.

Ancak 100 yazdığımızda yanıt vermiyor,işlem sonuçlanamıyor.
Bazı öğrencilerin tam puan aldığını düşünürsek 100 yazınca sorun olmaması (puanlamanın tam dağılabilmesi) gerekiyor.

Bir de 100'den büyük sayı yazınca hücrelere YANLIŞ gibi bir ifade girilse öğretmen yaptığı yanlışı çok çabuk farkederdi.

Benim örneğim dersine girdiğim 950 civarında öğrencim var, hızlı giriş yaparken 100 den büyük sayı yazma riski çok

Emeğinize tekrar teşekkür ederim.

Korhan Ayhan · 9 Haziran 2010

Selamlar,

Üstteki mesajımdaki kodu ve dosyayı güncelledim. İncelermisiniz.

Muhammet Okumuş · 16 Haziran 2010

Yukarıdaki kodda hiç bir sütunda 0 (sıfır) değeri almıyor.Sıfır almasını nasıl sağlayabiliriz?

sangelosa · 18 Haziran 2010

Evet denedim, şimdi 100 girince ve yüzden büyük sayı girince sorun olmuyor.
Teşekkürler emeğiniz için.
excel kullanma konusunda hep kendimi geliştirmeye çalışıyorum,
desteğiniz sayesinde daha da ilerleyeceğim inş

Saygılar.

Korhan Ayhan · 18 Haziran 2010

Selamlar,

Sn. muokumus,

Üstteki mesajımdaki kodu aşağıdaki şekilde değiştirirseniz sıfır (0) değerlerde listelenecektir.

muokumus' Alıntı:
Yukarıdaki kodda hiç bir sütunda 0 (sıfır) değeri almıyor.Sıfır almasını nasıl sağlayabiliriz?

Kod:

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("H3:H65536")) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    If Target <> Empty And IsNumeric(Target) Then
    Range("B" & Target.Row & ":G" & 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 = 2 To 7
            Cells(Target.Row, X) = Cells(1, X)
        Next
        GoTo Son
    End If
    
BAŞLA:
    Randomize
    SAYI = Int(Rnd * [COLOR=red]21[/COLOR])
    For X = 2 To 7
        If Cells(Target.Row, X) = [COLOR=red]""[/COLOR] Then
            If SAYI <= Cells(1, X) Then
                If WorksheetFunction.Sum(Range("B" & Target.Row & ":G" & 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("B" & Target.Row & ":G" & Target.Row)) <= 6 And _
    WorksheetFunction.Sum(Range("B" & Target.Row & ":G" & Target.Row)) <> Target Then
    Range("B" & Target.Row & ":G" & Target.Row).ClearContents
    GoTo BAŞLA
    End If
    
    MsgBox "Not dağılımı tamamlanmıştır.", vbInformation
    
    Else
    
    Range("B" & Target.Row & ":G" & Target.Row).ClearContents
    
    End If
Son:
    Application.ScreenUpdating = True
End Sub

qazqaz1111112 · 5 Ocak 2012

Slm ben bu kodların sütun sayısını ve verilebilecek en yüksek değerleri değiştirdim. Bu durumda yine çalışıyor fakat 80 ve üstü not girince excel çok yavaşlıyor lütfen acil yardım.80 ' den aşağı not girince çok hızlı ama 80 ve üstü çok yavaş hatta bazen kasıyor. Acil yardım lütfen...

qazqaz1111112 · 6 Ocak 2012

Acil yardım lütfen

birey111 · 15 Ocak 2012

korhan bey süpersin teşekkür edrim arayıpta bılamadığığmız program

qazqaz1111112 · 17 Ocak 2012

lütfen sn korhan ayhan yardım edin neden böyle yavaş hesaplıyor yada bilen birileri varsa acil yardım lütfen...

birey111 · 17 Ocak 2012

qazqaz1111112' Alıntı:
Slm ben bu kodların sütun sayısını ve verilebilecek en yüksek değerleri değiştirdim. Bu durumda yine çalışıyor fakat 80 ve üstü not girince excel çok yavaşlıyor lütfen acil yardım.80 ' den aşağı not girince çok hızlı ama 80 ve üstü çok yavaş hatta bazen kasıyor. Acil yardım lütfen...

Aynen katılıyorum...Zaten genelde 80-100 arası notlar veriliyor onda da kasıyor . Ben ekteki gibi değiştirmeye çalıştım kodları ama 80 üstü çok kasıyor. Acil yardım...

qazqaz1111112 · 18 Ocak 2012

BEN DE ŞÖYLE YApTIM YİNE OLMADI YARDIM LÜTFENNNN

qazqaz1111112 · 18 Ocak 2012

bilen birileri yardım etsin gerçekten çok önemli bir şey bu.Lütfen yardım edecek arkadaşlar acele edin. Ben başka şekillerde denedim defalarca ama olmadı olmadı olmadı.Bir püf noktası var veya başka bir formülmü lazım bilemiyorum.Tek çarem burası yardım lütfen...

birey111 · 19 Ocak 2012

qazqaz1111112' Alıntı:
bilen birileri yardım etsin gerçekten çok önemli bir şey bu.Lütfen yardım edecek arkadaşlar acele edin. Ben başka şekillerde denedim defalarca ama olmadı olmadı olmadı.Bir püf noktası var veya başka bir formülmü lazım bilemiyorum.Tek çarem burası yardım lütfen...

If WorksheetFunction.CountA(Range("B" & Target.Row & ":H" & Target.Row)) <= 7 And

satırdaki 7 yi düşük bir değer yapınca hızlı atıyor ama snuç tutmuyor malesef...

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("I3:I65536")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

If Target <> Empty And IsNumeric(Target) Then
Range("B" & Target.Row & ":H" & 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 = 2 To 8
Cells(Target.Row, X) = Cells(1, X)
Next
GoTo Son
End If

BAŞLA:
Randomize
SAYI = Int(Rnd * 15 + 1)
For X = 2 To 8
If Cells(Target.Row, X) = Empty Then
If SAYI <= Cells(1, X) Then
If WorksheetFunction.Sum(Range("B" & Target.Row & ":H" & 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("B" & Target.Row & ":H" & Target.Row)) <= 7 And _
WorksheetFunction.Sum(Range("B" & Target.Row & ":H" & Target.Row)) <> Target Then
Range("B" & Target.Row & ":H" & Target.Row).ClearContents
GoTo BAŞLA
End If

MsgBox "Not dağılımı tamamlanmıştır.", vbInformation

Else

Range("B" & Target.Row & ":H" & Target.Row).ClearContents

End If

Son:
Application.ScreenUpdating = True
End Sub

Ben şöyle düşünüyorum;

alttaki eşitlik gibi;
If Target = 100 Then
For X = 2 To 8
Cells(Target.Row, X) = Cells(1, X)
Next
GoTo Son
End If

burada 100 olunca hepsine en büyük değeri atıyor...
bu eşitlikteki gibi bir formül;
= 99 ise en sondaki sütündan 1 sil(h sütünü),

=98 ise en sondan ve ondan sonrakinden 1 sil( h ve g sütunundan)
diye gidecek bir formül....

sadece birini gösterseler ben 80 kadar hepsini tek tek yazarım...
yardım lütfen...

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

sangelosa

Korhan Ayhan

Administrator

sangelosa

Ergün Güler

sangelosa

Ekli dosyalar

Korhan Ayhan

Administrator

Ekli dosyalar

sangelosa

sangelosa

Korhan Ayhan

Administrator

Muhammet Okumuş

Destek Ekibi

sangelosa

Korhan Ayhan

Administrator

qazqaz1111112

qazqaz1111112

birey111

qazqaz1111112

birey111

Ekli dosyalar

qazqaz1111112

Ekli dosyalar

qazqaz1111112

birey111