• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

textboxlarda ortalama

B

blacklife07

Katılım
6 Nisan 2009
Mesajlar
22
Excel Vers. ve Dili
vba
Listeden kişileri seçince onun bilgilerini textboxlara alıyorum. Bu textboxlara gelen 4 adet sayının ortalamasını bir başka texboxa atayabiliyorum. Fakat bazen bu değerler 4 adet olmayabiliyor. Bazen1, bazen 2, bazen 3, bazen 4 değer olsada ortalamanın o texboxa atanması için nasıl bir kod yazılabilir. aramalarımda bir sonuca ulaşamadım.

Yardımlarınız için şimdiden teşekkürler.
 

Ekli dosyalar

merhaba.

genellikle sorulan bir soru ile ilgili forumda bir çok örnek var ise cevap alamayabilirsiniz.

bir diğer husus sorunuzun açık ve anlaşılır olmamasıdır.

sizin konu için 2 durum da geçerli.

dosyanızı açtım. tam 14 tane form var. hesaplamaların hangi formda yapıldığını öğrenmek için tek tek 14 tane forma tıklamak, kodları görüntülemek, ortalamayı nasıl hesapladığınızı bulmak gerekiyor.

her biri 2 dakika sürsün. tesadüf sizin işlemler de sonuncu formda olsun. yarım saat eder. kimseden sizin sorunuzun ne olduğunu öğrenmesi için yarım saat harcamasını bekleyemezsiniz zannederim. (çözüm üretmek için harcanacak zamanı eklemedim.)

nitekim ben de formlara ve kodlarına bakmadım.

4 textbox verisini kullanarak hesaplamayı textbox5'e yazan kod örnek olarak verilmiştir. kendi olayınıza uyarlarsınız.

Kod: 
Sub ort_hesap()

    Dim say As Long
    Dim toplam As Single
    
    If TextBox1.Value <> "" Then
        say = say + 1
        toplam = toplam + TextBox1.Value
    End If
    If TextBox2.Value <> "" Then
        say = say + 1
        toplam = toplam + TextBox2.Value
    End If
    If TextBox3.Value <> "" Then
        say = say + 1
        toplam = toplam + TextBox3.Value
    End If
    If TextBox4.Value <> "" Then
        say = say + 1
        toplam = toplam + TextBox4.Value
    End If
    
    If say > 0 Then
        TextBox5.Value = toplam / say
    Else
        TextBox5.Value = ""
    End If

End Sub
 
Selamlar,

Bende cevap hazırlamıştım. İncelermisiniz.

Kod: 
Private Sub hesap_Click()
Dim say, deg1, deg2, deg3, deg4
On Error Resume Next
 
If TextBox13 <> "" Then say = say + 1: deg1 = CDbl(TextBox13)
If TextBox14 <> "" Then say = say + 1: deg2 = CDbl(TextBox14)
If TextBox15 <> "" Then say = say + 1: deg3 = CDbl(TextBox15)
If TextBox16 <> "" Then say = say + 1: deg4 = CDbl(TextBox16)
TextBox45 = VBA.Round(WorksheetFunction.Sum(deg1, deg2, deg3, deg4) / say, 2)
say = 0: deg1 = 0: deg2 = 0: deg3 = 0: deg4 = 0
 
If TextBox17 <> "" Then say = say + 1: deg1 = CDbl(TextBox17)
If TextBox18 <> "" Then say = say + 1: deg2 = CDbl(TextBox18)
If TextBox19 <> "" Then say = say + 1: deg3 = CDbl(TextBox19)
If TextBox20 <> "" Then say = say + 1: deg4 = CDbl(TextBox20)
TextBox46 = VBA.Round(WorksheetFunction.Sum(deg1, deg2, deg3, deg4) / say, 2)
say = 0: deg1 = 0: deg2 = 0: deg3 = 0: deg4 = 0
 
If TextBox21 <> "" Then say = say + 1: deg1 = CDbl(TextBox21)
If TextBox22 <> "" Then say = say + 1: deg2 = CDbl(TextBox22)
If TextBox23 <> "" Then say = say + 1: deg3 = CDbl(TextBox23)
If TextBox24 <> "" Then say = say + 1: deg4 = CDbl(TextBox24)
TextBox47 = VBA.Round(WorksheetFunction.Sum(deg1, deg2, deg3, deg4) / say, 2)
say = 0: deg1 = 0: deg2 = 0: deg3 = 0: deg4 = 0
 
If TextBox25 <> "" Then say = say + 1: deg1 = CDbl(TextBox25)
If TextBox26 <> "" Then say = say + 1: deg2 = CDbl(TextBox26)
If TextBox27 <> "" Then say = say + 1: deg3 = CDbl(TextBox27)
If TextBox28 <> "" Then say = say + 1: deg4 = CDbl(TextBox28)
TextBox48 = VBA.Round(WorksheetFunction.Sum(deg1, deg2, deg3, deg4) / say, 2)
say = 0: deg1 = 0: deg2 = 0: deg3 = 0: deg4 = 0
 
If TextBox29 <> "" Then say = say + 1: deg1 = CDbl(TextBox29)
If TextBox30 <> "" Then say = say + 1: deg2 = CDbl(TextBox30)
If TextBox31 <> "" Then say = say + 1: deg3 = CDbl(TextBox31)
If TextBox32 <> "" Then say = say + 1: deg4 = CDbl(TextBox32)
TextBox49 = VBA.Round(WorksheetFunction.Sum(deg1, deg2, deg3, deg4) / say, 2)
say = 0: deg1 = 0: deg2 = 0: deg3 = 0: deg4 = 0
 
If TextBox33 <> "" Then say = say + 1: deg1 = CDbl(TextBox33)
If TextBox34 <> "" Then say = say + 1: deg2 = CDbl(TextBox34)
If TextBox35 <> "" Then say = say + 1: deg3 = CDbl(TextBox35)
If TextBox36 <> "" Then say = say + 1: deg4 = CDbl(TextBox36)
TextBox50 = VBA.Round(WorksheetFunction.Sum(deg1, deg2, deg3, deg4) / say, 2)
say = 0: deg1 = 0: deg2 = 0: deg3 = 0: deg4 = 0
 
If TextBox37 <> "" Then say = say + 1: deg1 = CDbl(TextBox37)
If TextBox38 <> "" Then say = say + 1: deg2 = CDbl(TextBox38)
If TextBox39 <> "" Then say = say + 1: deg3 = CDbl(TextBox39)
If TextBox40 <> "" Then say = say + 1: deg4 = CDbl(TextBox40)
TextBox51 = VBA.Round(WorksheetFunction.Sum(deg1, deg2, deg3, deg4) / say, 2)
say = 0: deg1 = 0: deg2 = 0: deg3 = 0: deg4 = 0
 
If TextBox41 <> "" Then say = say + 1: deg1 = CDbl(TextBox41)
If TextBox42 <> "" Then say = say + 1: deg2 = CDbl(TextBox42)
If TextBox43 <> "" Then say = say + 1: deg3 = CDbl(TextBox43)
If TextBox44 <> "" Then say = say + 1: deg4 = CDbl(TextBox44)
TextBox52 = VBA.Round(WorksheetFunction.Sum(deg1, deg2, deg3, deg4) / say, 2)
say = 0: deg1 = 0: deg2 = 0: deg3 = 0: deg4 = 0
 
TextBox53.Value = "5"
TextBox54.Value = "8"
 
If (TextBox45.Value) <= (TextBox53.Value) Then TextBox45.BackColor = &HFF
If (TextBox45.Value) >= (TextBox53.Value) And (TextBox45.Value) <= (TextBox54.Value) Then TextBox45.BackColor = &H8080FF
If (TextBox45.Value) >= (TextBox54.Value) Then TextBox45.BackColor = &H8000&
End Sub
 
Korhan Ayhan' Alıntı:
Selamlar,

Bende cevap hazırlamıştım. İncelermisiniz.
Genişletmek için tıkla ...

hocam anladığım kadarı ile sizdeki gerçek veriler...

o zaman benim kodu sizin kodun yardımıyla kolayca aşağıdaki gibi bir koda dönüştürebiliriz zannediyorum. satır sayısı aynı olsun diye her bir hesaplamayı 6 satıra indirgedim :)

yalnız bu kodda bir tık ile 8 döngü çalışacağından performansı sizin koda göre düşük olacaktır zannediyorum.

değerlendirirseniz sevinirim.

Kod: 
Private Sub CommandButton1_Click()

    Dim say As Long
    Dim toplam As Single
    Dim i As Integer

    For i = 13 To 16
        With Me.Controls("Textbox" & i)
            If .Value <> "" Then say = say + 1: toplam = toplam + .Value
        End With
    Next
    If say > 0 Then TextBox45.Value = toplam / say: i = 0: say = 0: toplam = 0

    For i = 17 To 20
        With Me.Controls("Textbox" & i)
            If .Value <> "" Then say = say + 1: toplam = toplam + .Value
        End With
    Next
    If say > 0 Then TextBox46.Value = toplam / say: i = 0: say = 0: toplam = 0

    For i = 21 To 24
        With Me.Controls("Textbox" & i)
            If .Value <> "" Then say = say + 1: toplam = toplam + .Value
        End With
    Next
    If say > 0 Then TextBox47.Value = toplam / say: i = 0: say = 0: toplam = 0

    For i = 25 To 28
        With Me.Controls("Textbox" & i)
            If .Value <> "" Then say = say + 1: toplam = toplam + .Value
        End With
    Next
    If say > 0 Then TextBox48.Value = toplam / say: i = 0: say = 0: toplam = 0

    For i = 29 To 32
        With Me.Controls("Textbox" & i)
            If .Value <> "" Then say = say + 1: toplam = toplam + .Value
        End With
    Next
    If say > 0 Then TextBox49.Value = toplam / say: i = 0: say = 0: toplam = 0

    For i = 33 To 36
        With Me.Controls("Textbox" & i)
            If .Value <> "" Then say = say + 1: toplam = toplam + .Value
        End With
    Next
    If say > 0 Then TextBox50.Value = toplam / say: i = 0: say = 0: toplam = 0

    For i = 37 To 40
        With Me.Controls("Textbox" & i)
            If .Value <> "" Then say = say + 1: toplam = toplam + .Value
        End With
    Next
    If say > 0 Then TextBox51.Value = toplam / say: i = 0: say = 0: toplam = 0

    For i = 41 To 44
        With Me.Controls("Textbox" & i)
            If .Value <> "" Then say = say + 1: toplam = toplam + .Value
        End With
    Next
    If say > 0 Then TextBox52.Value = toplam / say: i = 0: say = 0: toplam = 0

End Sub
 
Sn.Mancubus ve Sn.Korhan Ayhan çok teşekkür ederim. Cehaletimi ve bilgisizliğimi mazur görün. Sizleri yargılamak gibi asla bir niyetim yoktu. Yanlış anlaşıldıysam çok özür diliyorum.
Kendi zamanınızı bizlerin sorularına ayırıp cevaplamaya çalışmanız takdire değerdir.......
Verdiğiniz her üç kodun üçünüde ayrı ayrı denedim sorunsuz çalışıyor....İlgilenip cevap veriğiniz için Sn.Mancubus, dosyama uydun tüm kodları verdiğiniz için Sn.Korhan Ayhan tekrar teşekkür ederim.
 
estağfurullah.

sadece sorularımızı sorarken cevap vermeye gönüllü olacaklara daha fazla yardımcı olmak lazım.

uzmanlar yanında benim gibi orta derecede bilgi sahibi olanlar da cevap vermeye çalışıyor.

bu aslında öğrenme sürecinin de bir parçası. başkalarının sorularına bakarak bilmediğiniz konularda araştırma yapmak ve bu şeklde öğrenmeye devam etmek, bildiğiniz bir şeyi farklı bir pencereden değerlendirmek ve yine yeni bir şey öğrenmek....

kolay gelsin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst