Satırlara Formül Getirme

[ömer855]

Merhaba, Excelde satırlara VBA ile çokeğersay formülünü kaç satır varsa kopyalatıyorum(satır sayısı değişken olabiliyor) fakat satırı çok olan veride formül kopya yapıştır sonrası excel hesaplama ya geçtiğinden uzun sürüyor. bunu vba içerisinde hesaplatıp satırdaki hücrelere direkt sonucu hızlı birşekilde döndüremez miyiz ? Kullandığım formül aşağıdadır.

With Sheets("çift")
        son = .Cells(.Rows.Count, 1).End(3).Row
        .Range("m3:m" & son).Formula = "=COUNTIFS(ÇİFT!D:D,ÇİFT!D3,ÇİFT!F:F,ÇİFT!F3,ÇİFT!I:I,ÇİFT!I3)"
        .Range("o3:o" & son).Formula = "=COUNTIFS(ÇİFT!E:E,ÇİFT!E3,ÇİFT!F:F,ÇİFT!F3,ÇİFT!G:G,ÇİFT!G3,ÇİFT!I:I,ÇİFT!I3)"
        
    End With

Yardımlarınız için şimdiden teşekkürler

 

[ÖmerFaruk]

Şunu bir deneyin.
Örnek dosyanız olmadan boş dosyada yazdım. Hata verirse bilgi verisiniz.

Sub CountIfsHesapla()
Dim Liste1(), Liste2(), AlanD As Range, AlanE As Range, AlanF As Range, AlanG As Range, AlanI As Range
Dim i As Long, Zaman As Double
    i = Worksheets("ÇİFT").Range("A" & Rows.Count).End(3).Row
    If i < 3 Then Exit Sub
    Zaman = Timer
    Set AlanD = Range("D3:D" & i)
    Set AlanE = Range("E3:E" & i)
    Set AlanF = Range("F3:F" & i)
    Set AlanG = Range("G3:G" & i)
    Set AlanI = Range("I3:I" & i)
    
    ReDim Liste1(1 To i - 2, 1 To 1)
    ReDim Liste2(1 To i - 2, 1 To 1)
    
    For i = 1 To Son - 2
        Liste1(i, 1) = WorksheetFunction.CountIfs(AlanD, AlanD.Cells(i, 1), AlanF, AlanF.Cells(i, 1), AlanI, AlanI.Cells(i, 1))
        Liste2(i, 1) = WorksheetFunction.CountIfs(AlanE, AlanE.Cells(i, 1), AlanF, AlanF.Cells(i, 1), AlanG, AlanG.Cells(i, 1), AlanI, AlanI.Cells(i, 1))
    Next i
    Worksheets("ÇİFT").Range("M3").Resize(UBound(Liste1), 1) = Liste1
    Worksheets("ÇİFT").Range("O3").Resize(UBound(Liste2), 1) = Liste2
    Set AlanD = Nothing: Set AlanE = Nothing: Set AlanF = Nothing: Set AlanG = Nothing: Set AlanI = Nothing
    Erase Liste1: Erase Liste2
    MsgBox "İşlem süresi = " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub