Soru Toplaçarpım formülünü vba koduna çevirme

[mustafa]

Merhabalar,

Bir konuda daha ustaların yardımını isteyeceğim. Aşağıdaki formülleri "Basketbol" adlı sayfaya ekleyince dosyada işlem yapmak çok ağırlaşıyor, baya bi bekletiyor. Formülleri silince sorun kalmıyor. Acaba bu formüller vba kodu ile yazılabilir mi, belki bu yavaşlama sorunu ortadan kalkar.

Basketbol sayfası V2 sütunu

=TOPLA.ÇARPIM((ALTTOPLAM(103;KAYDIR(V6:Y25000;SATIR(V6:Y25000)-MİN(SATIR(V6:Y25000));0;1;1)))*(V6:Y25000<U6:U25000)*(U6:U25000<>""))

Basketbol sayfası W2 sütunu

=TOPLA.ÇARPIM((ALTTOPLAM(103;KAYDIR(V6:Y25000;SATIR(V6:Y25000)-MİN(SATIR(V6:Y25000));0;1;1)))*(V6:Y25000>=U6:U25000)*(U6:U25000<>""))

Basketbol sayfası X2 sütunu

=YUVARLA(ALTTOPLAM(109;U6:U25000)/ALTTOPLAM(102;U6:U25000);0)

Basketbol sayfası Y2 sütunu

=YUVARLA(ALTTOPLAM(109;Z6:Z25000)/ALTTOPLAM(102;Z6:Z25000);0)

 

[yanginci34]

Kodların en başındaki açıklamalara göre yapıştırıp denermisiniz.

'doğrudan sayfanın kod alanına yapıştırın'
Private Sub Worksheet_Calculate()
    Call BasketbolOtomatikHesapla
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Me.Range("U6:Z25000")) Is Nothing Then
        Application.EnableEvents = False
        Call BasketbolOtomatikHesapla
        Application.EnableEvents = True
    End If
End Sub

'bunu bir modüle yapıştırın'
Sub BasketbolOtomatikHesapla()
    Dim ws As Worksheet
    Dim i As Long, sonSatir As Long
    Dim sayVkleU As Long, sayVbuyukU As Long
    Dim toplamU As Double, toplamZ As Double
    Dim sayU As Long, sayZ As Long

    Set ws = ThisWorkbook.Sheets("Basketbol")
    sonSatir = ws.Cells(ws.Rows.Count, "U").End(xlUp).Row

    Application.ScreenUpdating = False

    For i = 6 To sonSatir
        ' Sadece görünür satırlar (filtre sonrası)
        If Not ws.Rows(i).Hidden Then
            If ws.Cells(i, "U").Value <> "" And ws.Cells(i, "V").Value <> "" Then
                If ws.Cells(i, "V").Value < ws.Cells(i, "U").Value Then
                    sayVkleU = sayVkleU + 1
                ElseIf ws.Cells(i, "V").Value >= ws.Cells(i, "U").Value Then
                    sayVbuyukU = sayVbuyukU + 1
                End If
            End If
            
            ' Ortalama için U sütunu
            If IsNumeric(ws.Cells(i, "U").Value) And ws.Cells(i, "U").Value <> "" Then
                toplamU = toplamU + ws.Cells(i, "U").Value
                sayU = sayU + 1
            End If
            
            ' Ortalama için Z sütunu
            If IsNumeric(ws.Cells(i, "Z").Value) And ws.Cells(i, "Z").Value <> "" Then
                toplamZ = toplamZ + ws.Cells(i, "Z").Value
                sayZ = sayZ + 1
            End If
        End If
    Next i

    ' Sonuçları yaz
    ws.Range("V2").Value = sayVkleU
    ws.Range("W2").Value = sayVbuyukU
    ws.Range("X2").Value = IIf(sayU > 0, WorksheetFunction.Round(toplamU / sayU, 0), "")
    ws.Range("Y2").Value = IIf(sayZ > 0, WorksheetFunction.Round(toplamZ / sayZ, 0), "")

    Application.ScreenUpdating = True
End Sub

 

[mustafa]

Cevap için teşekkürler fakat ben uyarlayamadım, dosya ekte, size zahmet kodları uyarlayabilir misiniz?

 

[yanginci34]

Buyrun
sizin Worksheet_Calculate ve Worksheet_Change sayfa kodlarınız da daha önce kod olduğundan içlerine benim kodlarımı döşeme yaptım ilk baştan bu örneği paylaşılmasının önemi bu şekilde anlaşılmış oldu

 

[mustafa]

Üstat eline sağlık fakat V ve W sütunlarında renkleri sayması gerekiyor. X ve Y sütunlarındaki ortalamalarda sorun yok ama V ve W sütunlarındaki renk sayımı yanlış. Bunu düzeltebilirseniz çok memnun olurum.

 

[yanginci34]

Üstat eline sağlık fakat V ve W sütunlarında renkleri sayması gerekiyor. X ve Y sütunlarındaki ortalamalarda sorun yok ama V ve W sütunlarındaki renk sayımı yanlış. Bunu düzeltebilirseniz çok memnun olurum.

V İLE W sütunlarında ne yapmak istediğinizi yazın ona göre kodu güncelleyelim

 

[mustafa]

Üstat,

V sütununda V-Y sütunundaki sayılar U sütunundaki sayılarla karşılaştırılacak ve küçük olanların sayısını verecek.

W sütununda ise yine V-Y sütunundaki sayılar U sütunundaki sayılarla karşılaştırılacak ve büyük ya da eşit olanların sayısını verecek.