Makro ile değerleri bulup analiz etmek

[sbayyigit]

Arkdaşlar merhaba
Yapmak istedğim şey listedeki eğitim durumlarına göre verilen puanları toplamak.
örnek olarak ekteki dosyada Soru 3'e verilen cevapları değerlendirirken

1 den 3' kadar verilen puanlar var

Eğitim durumlarına göre (orneğin soru 3 e verilen puanları) listeye yazarken makro ile bulup eklemek istiyorum
Bu işlem soru 19 da Meslek grupları için de gerekecek dolayısıyla bu işe bir çözüm bulmam gerek
Dizi oluşturma konusunda hiçbir tecrübem yok dolayısıyla yazacağım kodlar çok uzuyor.
yardımlarınız için teşekkür ederim.

 

[sbayyigit]

arkdaşlar sorunumu kendim çözdüm. tabiiki sitedeki kodlardan yararlanarak. bütün arkdaşlara teşekkür ederim.
ayrıca başkaları da faydalanır diye kodlarımı yayınlıyorum. isteyen değiştirebilir.
örnek meslek gruparına göredir.
kod;

Private Sub Userform_Initialize()
Set s1 = Sheets("ayaktan")
Dim i As Long, soru, sut, evet, hayir, biraz As Integer
s1.Range("ab8:ad100").ClearContents
sut = s1.Cells(26, 21).End(xlToLeft).Column
soru = s1.Range("aa1").Value + 7
a = 8
For i = 2 To sut
If WorksheetFunction.CountIf(Range(Cells(26, 2), Cells(26, i)), Cells(26, i).Value) = 1 Then
'bu kodla benzersiz kayıtlar bulunuyor

s1.Cells(a, "aa").Value = Cells(26, i).Value
a = a + 1
End If
Next i
For b = 8 To a - 1
evet = 0
biraz = 0
hayir = 0
For c = 2 To sut
If Cells(26, c).Value = s1.Range("aa" & b).Value Then
If Cells(soru, c).Value = 3 Then
evet = evet + 1
ElseIf Cells(soru, c).Value = 2 Then
biraz = biraz + 1
ElseIf Cells(soru, c).Value = 1 Then
hayir = hayir + 1
End If
End If
Next c
s1.Range("ab" & b).Value = evet
s1.Range("ac" & b).Value = biraz
s1.Range("ad" & b).Value = hayir
Next b
End Sub