Çözüldü Üsüste Topla, KDV Hariç ve Dahil Ortalama Al

[sirkülasyon]

Es Selamün Aleyküm.
Hayırlı Sabahlar
Ekli dosyada
C2 hücresinde yüzde oranı seçildikten sonra
C3 hücresine ortalaması alınacak rakamlar üst üste girilir. (C3 hücresinde girilen rakamlar üst üste toplanır)
C4 Hücresine KDV Hariç (C3 hücresine kaç adet rakam girildiyse)ortalaması alınır.
C5 Hücresine KDV Dahil (C3 hücresine kaç adet rakam girildiyse) ortalaması alınır.

Rica etsem yukarıda ki açıklamalara göre ekli dosyama yardımcı olabilir misiniz? Şimdiden ilgilenen tüm üstadlara teşekkür eder, saygılarımı sunarım.

 

[Muzaffer Ali]

Aleykümselam.

Sayfanıza bir "CommandButton" ekleyin ve adını "btnTemizle" olarak değiştirin.
Bu butona tıkladığınızda rakam ve adet bilgileri sıfırlanacaktır.

Sayfanızın kod kısmına aşağıdaki kodları kopyalayın.

Option Explicit

Dim Rakam As Currency
Dim Adet As Long
    
Private Sub btnTemizle_Click()
    Rakam = Empty
    Adet = Empty
    Range("C3:C5").ClearContents
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [C3]) Is Nothing Or Target.Text = "" Then Exit Sub
    If Not IsNumeric(Target.Value) Then
        MsgBox "Lütfen geçerli bir rakam giriniz."
        Exit Sub
    End If
    Rakam = Rakam + Target.Value
    Adet = Adet + 1
    [C4] = (Rakam / Adet)
    [C5] = [C4] + (Rakam / Adet) * ([C2] / 100)
End Sub

 

[sirkülasyon]

6,42
6,43
6,25
6,45
6,41
6,41
6,47
6,39

Üst üste toplanmış hali : 51,23
KDV Dahil : 6,40
KDV Hariç : 5,42
Makro hatalı gibi sayın dalgalikur. Kontrol edebilmeniz mümkün mü?

 

[Muzaffer Ali]

Yazılan rakamın kdv dahil mi hariç mi olduğunu yazmamıştınız ben hariç olarak düşünüp kod yazdığım için hatalı sonuç verdi.

Aşağıdaki kodları kullanabilirsiniz.

Dim Rakam As Currency
Dim Adet As Long
Dim Haric As Currency
   
Private Sub btnTemizle_Click()
    Rakam = Empty
    Adet = Empty
    Haric = Empty
    Range("C3:C5").ClearContents
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [C3]) Is Nothing Or Target.Text = "" Then Exit Sub
    If Not IsNumeric(Target.Value) Then
        MsgBox "Lütfen geçerli bir rakam giriniz."
        Exit Sub
    End If
    Rakam = Rakam + Target.Value
    Adet = Adet + 1
    [C5] = (Rakam / Adet)
    Haric = Haric + (Target.Value / (([C2] / 100) + 1))
    [C4] = Haric / Adet
End Sub

 

[sirkülasyon]

Sayın dalgalikur
Hakkınızı helal edin. Size rahatsızlık veriyorum.
C3 hücresine girilen rakamları üst üste toplayacak
C4 Hücresine KDV HARİÇ
C5 hücresine KDV DAHİL ortalama alacak

6,42
6,43
6,25
6,45
6,41
6,41
6,47
6,39

Üst üste toplanmış hali : 51,23 (Sekiz adet rakamın toplamı)
KDV Dahil : 6,40
KDV Hariç : 5,42

Bende sadece girilen rakamın işlemini yapıyor

 

[Muzaffer Ali]

Tamam şimdi anladım.
C3 e hem rakam girilecek ve hem de girilen rakamların toplamını yazacak.
Aşağıdaki kodları deneyin.

Option Explicit

Dim Rakam As Currency
Dim Adet As Long
Dim Haric As Currency
    
Private Sub btnTemizle_Click()
    Rakam = Empty
    Adet = Empty
    Haric = Empty
    Range("C3:C5").ClearContents
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [C3]) Is Nothing Or Target.Text = "" Then Exit Sub
    If Not IsNumeric(Target.Value) Then
        MsgBox "Lütfen geçerli bir rakam giriniz."
        Exit Sub
    End If
    Rakam = Rakam + Target.Value
    Adet = Adet + 1
    [C5] = (Rakam / Adet)
    Haric = Haric + (Target.Value / (([C2] / 100) + 1))
    [C4] = Haric / Adet
    Application.EnableEvents = False
    [C3] = Rakam
    Application.EnableEvents = True
End Sub

 

[sirkülasyon]

Hakkınızı Helal Edin. Teşekkür eder, Saygılarımı sunarım.
Sağ Ol, Var Ol

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.