Max,Min,Ortalama,Standard Sapma

[bage]

Arkadaşlar,
Ek'li dosyada TextBox'lara girilen değerlerin

Maksimum
Minimum
Aritmetik Ortalama
Standard Sapma

değerlerini ilgili TextBox'lara hesaplatmak istiyorum. Hesaplama işlemini bir CommandButton'a bağlı olarak değil de, bütün TextBox'lar dolu ise ve Exit olayı ile yapmak istiyorum.

Bu konuda bilgi ve tecrübesi olan arkadaşlar yardımcı olurlar ise memnun olurum. Þimdiden yardımcı olacak arkadaşlara çok teşekkür ederim...

 

[Haluk]

3 Tane TextBox için;

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    v1 = Val(TextBox1)
    v2 = Val(TextBox2)
    v3 = Val(TextBox3)
    Arr = Array(v1, v2, v3)
    Rmin = Application.WorksheetFunction.Min(Arr)
    Rmax = Application.WorksheetFunction.Max(Arr)
    Rav = Application.WorksheetFunction.Average(Arr)
    Rstd = Application.WorksheetFunction.StDev(Arr)
    MsgBox "Min: " & Rmin & vbCrLf _
         & "Max: " & Rmax & vbCrLf _
         & "Ort: " & Rav & vbCrLf _
         & "Std. Sapma: " & Format(Rstd, "0.00")
End Sub

 

[bage]

Sn Raider,
ilginiz için teşekkür ederim.
Ek'li dosyada kodları ile birlikte dosyayı gönderiyorum. Daha önceleri Sn Ã?.Faruk Duman yardımıyla hazırlamıştım. Diğer kısmların hazırlanması konusunda daha fazla yüzsüzlük yapmak istemediğimden yarım kalmıştı.
Acaba Döngü(ler) ile Max,Min,StdSapma,Ortalama değerlerini hesaplatmamız mümkün mü?

 

[Haluk]

En son "txtolcum22" nesnesinden çıktan sonra çalışmak üzere ...

Private Sub txtolcum22_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim Arr()
    j = 1
    
    For i = 1 To 22
        If Not Controls("txtolcum" & i) = Empty Then
            ReDim Preserve Arr(1 To j)
            Arr(j) = Val(Controls("txtolcum" & i))
            j = j + 1
        End If
    Next
    
    Rmin = Application.WorksheetFunction.Min(Arr)
    Rmax = Application.WorksheetFunction.Max(Arr)
    Rav = Application.WorksheetFunction.Average(Arr)
    Rstd = Application.WorksheetFunction.StDev(Arr)
    
    MsgBox "Min: " & Rmin & vbCrLf _
         & "Max: " & Rmax & vbCrLf _
         & "Ort: " & Format(Rav, "0.00") & vbCrLf _
         & "Std. Sapma: " & Format(Rstd, "0.00")
End Sub

 

[bage]

Sn Raider,
Ek'li dosyadaki verileri girdiğimiz vakit, Excel çalışma sayfasında hesaplanan değer ile kod ile hesaplanan değerler birbirini tutmuyor!!

 

[Haluk]

Birebir aynısı çıkıyor, hiçbir yanlışlık yok. (Bir sürü data girmek zorunda kaldım...)

Not: Değerleri TextBox'lara girerken virgül yerine nokta ile gireceksiniz.

 

[bage]

Sn Raider,
yardımlarınız için teşekkür ederim.
Mesaimiz bittiği için kodları deneyemedim.

ellerinize sağlık...

Herkesin 30 Ağustos Bayramını kutlarım...

Saygılarımla...

 

[bage]

Slm,
Araya Bayram tatili girdi, ancak bugün Sn Raider'ın söylediğini uygulayabildim. Fakat şöyle bir sorun var :
İnsanların alışkanlıkları gereği sayısal değerler girerken virgül kullanmayı tercih ediyorlar. Virgül girilmesini engellemek için şu kodları kullanıyorum :

Private Sub txtolcum1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 If KeyAscii < 44 Or KeyAscii > 57 Or KeyAscii = 45 Or KeyAscii = 47 Then
 KeyAscii = 0
End If

 If KeyAscii = 44 Then KeyAscii = 46
End Sub

Buradaki sorun ise ; 22 tane TextBox var ve bunların herbirisi için bu kodları yazmak biraz kod kalabalığı gibi geliyor bana! Bunu acaba daha kısa ve kestirme yoldan yapma imkanı var mı?

 

[Haluk]

Ufak bir Class Module ilavesi ile olur.

Ekli örneği inceleyiniz.

 

[bage]

Sn Raider,
Yazmış olduğunuz kodları denedim.. txtolcum1 adlı TextBox'a ondalıklı bir rakam girdiğim vakit Excel kilitleniyor.
Diğer TextBox'lara ondalıklı rakam girince ise, her rakam ve virgül girişimde biraz program yavaş çalışıyor...

 

[Haluk]

Merhaba;

Ondalıklı sayı girişleri için virgül kullanılması durumunda ekli dosya bende sorunsuz çalışıyor.

 

[bage]

Sn Raider,
Kusura bakmayın, sorularım ve sorunlar arka arkaya geliyor, fakat negatif bir değer girilince hata mesajı veriyor.
:?

 

[Haluk]

Class Module içindeki kodları aşağıdakilerle değiştirin;

Public WithEvents MyTxtBox As MSForms.TextBox
'
Private Sub MyTxtBox_Change()
    Dim Arr() As Double
    j = 1

    For i = 1 To 22
        If Not frmdeneme.Controls("txtolcum" & i) = Empty Then
    On Error Resume Next
            ReDim Preserve Arr(1 To j)
            Arr(j) = (frmdeneme.Controls("txtolcum" & i).Value)
            j = j + 1
        End If
    Next

    Rmin = Application.WorksheetFunction.Min(Arr)
    Rmax = Application.WorksheetFunction.Max(Arr)
    Rav = Application.WorksheetFunction.Average(Arr)
    Rstd = Application.WorksheetFunction.StDev(Arr)
    On Error GoTo 0
    
    frmdeneme.TextBox1 = Format(Rmax, "0.000")
    frmdeneme.TextBox2 = Format(Rmin, "0.000")
    frmdeneme.TextBox3 = Format(Rav, "0.000")
    frmdeneme.TextBox4 = Format(Rstd, "0.000")
End Sub

 

[bage]

Sn Raider,
Tek kelime ile harikasınız. Daha önce Sn. M.Temel Korkmaz'ın sitesinde de gerçekten sizin çözümlerinizi merak ve hayranlıkla takip ediyordum. Bu sitede de sizin engin bilginizden faydalanmak çok güzel.

Yardımlarınız için çok teşekkür ediyorum...

Not:
Form kurallarına ters mi olur bilemiyorum fakat şunu öğrenmek istiyorum : Acaba bu engin bilgilerinizin ışığında bir kitap ,CD vs. hazırlamayı düşünmüyor musunuz? Eğer var da, bizim haberimiz yok ise bu konuda bilgi verebilir misiniz?

Ayrıca herkesin Miraç Kandilini en içten dileklerimle kutluyorum...
:dua: :mutlu: :dua2:

 

[Haluk]

Sn. bage;

Ben XL ile sadece hobi olarak ve amatörce ilgileniyorum.

Sizin de kandiliniz kutlu olsun.