Koşullara uyan hücrelerin ortalaması

[umitumit]

Sorumu ekteki dosya içinde anlatmaya çalıştım.
A-B-C-D sütunlarındaki değerlere göre diğer sütunlardaki değerlerin ortalamasını istiyorum.
İlgilenen arkadaşlara şimdiden teşekkür ederim

 

[Recep İpek]

Şu an için aklıma gelen formülle yapılmış bir çalışmayı ekte bulabilirsiniz.

 

[umitumit]

sayın Recep İpek teşekkür ederim
ama fonksiyonla hesaplama yaptırdığımız zaman yıl boyunca biriken verilerin çokluğu nedeniyle hesaplama çok yavaşlıyor.
ayrıca B4-B5-B6-B7 hücrelerinden birini veya birkaçını boş bırakarakta hesaplama yapmak istiyorum.

 

[umitumit]

sanırım zor bi soru oldu...

 

[Tarkan VURAL]

Yanıt

Mantıklı olanı ADO ve SQL çözümü olduğu için bunu öneriyorum. Beğenmezseniz tabi başka çözümler de bulunabilir belki. Ama bence çok güzel oldu ve çok da hızlı sonuç veriyor. Dosyanızda sadece ufak değişiklikler gerekti. Onlar da DATA sayfasındaki başlıkların ("PAZ. ve SAT. GİDERİ" vb.) içindeki nokta işaretlerini kaldırmak.

GENEL ÜRETİM MAL
PAZ ve SAT GİDERİ
GENEL YÖN GİDERİ

Dener misiniz ?

DefStr B
Sub ortalama()
Dim con As ADODB.Connection
    Dim rs As ADODB.Recordset
        Dim evn As Worksheet
            Set evn = Worksheets("SUNUM")
                Set con = New ADODB.Connection
                    Set rs = New ADODB.Recordset

con.Open "provider=microsoft.jet.oledb.4.0;data source = " & _
    ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""
        b4 = 1
        
If evn.Range("b5").Value <> Empty Then b5 = evn.Range("b5").Value
    If evn.Range("b6").Value <> Empty Then b6 = evn.Range("b6").Value
        If evn.Range("b7").Value <> Empty Then b7 = evn.Range("b7").Value

sorgu = "select avg([RANDIMAN (Dm2/Adet)]) as ortRan, avg([A MASRAFI]) as ortA"
sorgu = sorgu & ",avg([B MASRAFI]) as ortB,avg([C MASRAFI]) as ortC"
sorgu = sorgu & ",avg([D MASRAFI]) as ortD,avg([İŞÇİLİK]) as ortis"
sorgu = sorgu & ",avg([GENEL ÜRETİM MAL]) as ortUrt"
sorgu = sorgu & ",avg([PAZ ve SAT GİDERİ]) as ortPaz "
sorgu = sorgu & ",avg([GENEL YÖN GİDERİ]) as ortYon ,avg([FİNANSMAN GİDERİ]) as ortFin "
sorgu = sorgu & " from [DATA$a5:t" & Sheets("DATA").Range("t65536").End(3).Row & "] "

dizi = Array(b4, b5, b6, b7)
    alan = "where [ÜRÜN]=" & b4
        If dizi(1) <> "" Then alan = alan & " and [PİYASA]=" & dizi(1)
            If dizi(2) <> "" Then alan = alan & " and [GRUP]=" & dizi(2)
                If dizi(3) <> "" Then alan = alan & " and [RENK]=" & dizi(3)

sorgu = sorgu & alan
    rs.Open sorgu, con, 1, 1
                
evn.Range("b10") = rs("ortRan")
    evn.Range("b12") = rs("ortA")
        evn.Range("b13") = rs("ortB")
            evn.Range("b14") = rs("ortC")
                evn.Range("b15") = rs("ortD")
                    evn.Range("b16") = rs("ortis")
                        evn.Range("b17") = rs("ortUrt")
                            evn.Range("b21") = rs("ortPaz")
                                evn.Range("b22") = rs("ortYon")
                                    evn.Range("b23") = rs("ortFin")
MsgBox "Ortalamalar hesaplanıp aktarılmıştır", vbInformation
    Set rs = Nothing
        Set con = Nothing
            Set s = Nothing
                b4 = vbNullString
                    b5 = vbNullString
                        b6 = vbNullString
                            b7 = vbNullString
                                sorgu = vbNullString
                                    alan = vbNullString
                                        Erase dizi
                                        
End Sub

Son olarak ActiveX Data Object referansını işaretlemeyi unutmayınız.
(VBE penceresi - Tools - References - Microsoft ActiveX Data Objects 2.6,2.7,2.8 Library)

İyi çalışmalar.