• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

FORMÜLÜ KODA ÇEVİRMEK

  • Konbuyu başlatan Konbuyu başlatan recep
  • Başlangıç tarihi Başlangıç tarihi
syn recep, bey
http://www.excel.web.tr/viewtopic.php?p=40515#40515 linkte.
syn Muallim, beye verdiğim cevap galiba sizi de ilgilendiriyor.
Kendinize göre uyarlayınız
formül kısmını sizinkiyle değiştiriniz. Yani Þöyle;

=IF(ROUND(AVERAGE(RC[-6]:RC[-1]),0)>84,5,IF(ROUND(AVERAGE(RC[-6]:RC[-1]),0)>69,4,IF(ROUND(AVERAGE(RC[-6]:RC[-1]),0)>54,3,IF(ROUND(AVERAGE(RC[-6]:RC[-1]),0)>44,2,IF(ROUND(AVERAGE(RC[-6]:RC[-1]),0)>-1,1,"" "" )))))
 
Selamlar.
Ben forumda şöyle bir kod almıştım. İşlemi yapıyor ancak içinde 400 yazan bir hata mesajı çıkıyor. Düzelten bir arkadaş olursa çok makbule geçecek. Kod şöyle:
Sub notlar()
Dim a As Double

For i = 2 To 50
a = WorksheetFunction.Average(Range("a" & i & " : " & "f" & i))

If Round(a, 1) > 84 Then
Range("g" & i) = "5"


ElseIf Round(a, 1) > 69 Then
Range("g" & i) = "4"


ElseIf Round(a, 1) > 54 Then
Range("g" & i) = "3"


ElseIf Round(a, 1) > 44 Then
Range("g" & i) = "2"

Else: Range("g" & i) = "1"
End If
Next

End Sub

:yardim:
 
Arkadaşlar,
Ortalama formül kodunun düzeltilmiş halini aşağıya yazıyorum. Sağolsun Bir arkadaşımız yardımcı oldu. Herhalde sizlerle paylaşmama kızmaz.
Sub notlar()
Dim a As Double
say = WorksheetFunction.CountA(Range("A:A"))

For i = 2 To say + 1
a = WorksheetFunction.Average(Range("a" & i & " : " & "f" & i))

If a > 84 Then
Range("g" & i) = 5


ElseIf a > 69 Then
Range("g" & i) = 4


ElseIf a > 54 Then
Range("g" & i) = 3


ElseIf a > 44 Then
Range("g" & i) = 2

Else: Range("g" & i) = 1
End If
Next

End Sub

Kolay gelsin.
Hepinize sevgi ve saygılar. :mutlu:
 
[vb:1:76f4ce4821]Function puanhesapla(ara As Range)
ort = WorksheetFunction.Average(ara)

If ort > 84 Then
puanhesapla = 5
Exit Function
Else
If ort > 69 Then
puanhesapla = 4
Exit Function
Else
If ort > 54 Then
puanhesapla = 3
Exit Function
Else
If ort > 44 Then
puanhesapla = 2
Exit Function
Else

If ort > -1 Then
puanhesapla = 1
Exit Function
End If
End If
End If
End If
End If

End Function
[/vb:1:76f4ce4821]
yukarıdaki fonksiyonu bir modül içerisine kopyalayın
çalışma sayfasında
=puanhesapla(aralıkişaretleyin veya yazın)


=puanhesapla(a1:a10) gibi
 
Geri
Üst