DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Uğraştım ama kodları bir türlü yazamadım.Yardım edebilecek arkadaş var mı?
For a = 5 To Cells(65000, 2).End(xlUp).Row
If Cells(a, 2) = "A" Then r = r + 1
Next
Cells(2, 2) = r
Cells(3, 2) = Cells(65000, 2).End(xlUp).Row - 4
Option Explicit
Sub HESAPLA()
Dim Son_Satır As Long
Son_Satır = Cells(Rows.Count, 2).End(3).Row
Range("B2") = WorksheetFunction.CountIf(Range("B5:B" & Son_Satır), "A")
Range("B3") = WorksheetFunction.CountA(Range("B5:B" & Son_Satır))
Range("E3") = Evaluate("=SUMPRODUCT((B5:B" & Son_Satır & "=""A"")*(E5:E" & Son_Satır & "=""D""))")
Range("E1") = Format(Range("E3") / Range("B3") * 100, "#,##0.00")
Range("E2") = Format(Range("E3") / Range("B2") * 100, "#,##0.00")
Range("G3") = Evaluate("=SUMPRODUCT((B5:B" & Son_Satır & "=""A"")*(G5:G" & Son_Satır & "=""D""))")
Range("G1") = Format(Range("G3") / Range("B3") * 100, "#,##0.00")
Range("G2") = Format(Range("G3") / Range("B2") * 100, "#,##0.00")
Range("I3") = Evaluate("=SUMPRODUCT((B5:B" & Son_Satır & "=""A"")*(I5:I" & Son_Satır & "=""D""))")
Range("I1") = Format(Range("I3") / Range("B3") * 100, "#,##0.00")
Range("I2") = Format(Range("I3") / Range("B2") * 100, "#,##0.00")
Range("K3") = Evaluate("=SUMPRODUCT((B5:B" & Son_Satır & "=""A"")*(K5:K" & Son_Satır & "=""D""))")
Range("K1") = Format(Range("K3") / Range("B3") * 100, "#,##0.00")
Range("K2") = Format(Range("K3") / Range("B2") * 100, "#,##0.00")
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub