Makro ile Koşullu toplama

[sbayyigit]

Merhaba arkadaşlar;
Ekteki liste örnek olarak alınmış aslında çok uzun ve kalite adı daha fazla(Kalite A, Kalite B.......Kalite G şeklinde Gidiyor);
Benim yapmak istediğim makro ile, Kaç tür Kalite varsa her bir kalitenin Evet ve Hayırlarının toplam puanını hesaplamak ve sonunda da genel toplamları bulmak.

ben bir döngü oluşturdum fakat oldukça uzun ve işlem bayaa beklettiği için sizin öneriniz olur diye sildim.
yardımlarınız için teşekkürler

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub kalite_59()
Dim z, sat As Long, list(), myarr(), n As Long, i As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("G2:J" & Rows.Count).ClearContents
Set z = CreateObject("Scripting.dictionary")
sat = Cells(Rows.Count, "A").End(xlUp).Row
list = Range("A2:E" & sat).Value
ReDim myarr(1 To 4, 1 To UBound(list))
For i = 1 To UBound(list)
    deg = list(i, 1)
    If Not z.exists(deg) Then
        n = n + 1
        z.Add deg, n
        myarr(1, n) = list(i, 1)
    End If
    If UCase(list(i, 5)) = "EVET" Then
        myarr(2, z.Item(deg)) = myarr(2, z.Item(deg)) + list(i, 4)
    End If
    If UCase(Replace(Replace(list(i, 5), "ı", "I"), "i", "İ")) = "HAYIR" Then
        myarr(3, z.Item(deg)) = myarr(3, z.Item(deg)) + list(i, 4)
    End If
    myarr(4, z.Item(deg)) = myarr(4, z.Item(deg)) + list(i, 4)
    
Next i
Erase list
Set z = Nothing
Range("G2").Resize(n, 4).Resize = Application.Transpose(myarr)
Range("G" & n + 3).Value = "TOPLAM"
Range("H" & n + 3 & ":J" & n + 3).Formula = "=sum(H$2:H$" & n + 1 & ")"
Erase myarr
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[sbayyigit]

eline sağlık evren hocam tam istediğim gibi

 

[Orion1]

eline sağlık evren hocam tam istediğim gibi

Rica ederim.
Merakımdan soruyorum,İşlem belirgin şekilde kısa sürdümü?

 

[beni_kimse_sevmiyo]

merhaba arkadaşlar...
ben excelde hücre içine liste oluşturdum fakat oluşturduğum listeden herhangi bir x ögesini seçtiğimde daha önce belirlediğim farklı hücrelere x ögesine bağlı bazı bilgilerin de beraberinde excelin çağırmasını istiyorum mümkün mü ??? mümkünse yardımlarınızı bekliyorum

 

[Orion1]

merhaba arkadaşlar...
ben excelde hücre içine liste oluşturdum fakat oluşturduğum listeden herhangi bir x ögesini seçtiğimde daha önce belirlediğim farklı hücrelere x ögesine bağlı bazı bilgilerin de beraberinde excelin çağırmasını istiyorum mümkün mü ??? mümkünse yardımlarınızı bekliyorum

Örnek dosya ekleyiniz ve orada elle manuel 1 -2 tane yapınız görelim ne yapılacak.Birazda açıklama yapınız.Bana olacak gibi geldi.

 

[sbayyigit]

Arkadaşlar kusura bakmayın yine kodlarla başım dertte; Evren hocam bir konudaki sorunuma çare buldu ama başka bir sorunum oldu. elimde bir liste var bu listede meslek grubu ve eğitim durumlarına göre bir analiz yapmam gerekiyor. Gerekli açıklamalar excel sayfası içerisinde mevcut. yardımlarınız için teşekkürler..