topla.çarpım formülünü makro ile yazmak

[warezamca]

Merhaba arkadaşlar,
Çalışma kitabımın sayfa2 kısmında E4 hücresinde aşağıda yazmış olduğum formül var.Bu formül sayesinde sayfa4 teki verilere göre hesaplama yapıp sayfa2 de ilgili hücreye yazdırıyorum.Fakat sayfa2 de bunun gibi birçok hücrede formül bulunduğu için işlem süresi artıyor ve çok bekleme oluyor.Aşağıdaki formülü bir CommandButton altında makro ile nasıl yazabilirim.

sayfa2 de E4 hücresindeki formül
=TOPLA.ÇARPIM((Sayfa4!$D$3:$D$20000=Sayfa2!$A4)*(Sayfa4!$F$3:$F$20000<>"")*(Sayfa4!$M$3:$M$20000=Sayfa2!$C$1))

sayfa2 de E5 hücresindeki formül
=TOPLA.ÇARPIM((Sayfa4!$D$3:$D$20000=Sayfa2!$A5)*(Sayfa4!$F$3:$F$20000<>"")*(Sayfa4!$M$3:$M$20000=Sayfa2!$C$1))

aynı şekilde diğer hücrelerdede (E6,E7,E8...) formül bulunuyor.

 

[mustafateknetas]

selam
aşağıdaki kodu denermisin


kod:
Sub formül_yaz()
Sheets("Sayfa2").Select
Range("E4").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((Sayfa4!R3C4:R20000C4=Sayfa2!RC1)*(Sayfa4!R3C6:R20000C6<>"""")*(Sayfa4!R3C13:R20000C13 =Sayfa2!R1C3))"
Range("E5").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((Sayfa4!R3C4:R20000C4=Sayfa2!RC1)*(Sayfa4!R3C6:R20000C6<>"""")*(Sayfa4!R3C13:R20000C13 =Sayfa2!R1C3))"
Range("E6").Select
Application.CommandBars("Task Pane").Visible = False
End Sub

 

[warezamca]

örnek dosyayı yükledim arkadaşlar

Göndermiş olduğum dosyada açıklamaya çalıştım yapmak istediğimi yardım edebilecek arkadaşlara şimdiden teşekkür ederim.Arkdaşlar formülü sayfa2 de hücrelere kaydetmesine gerek yok sadece ilgili firmanın hanesine hesaplayıp sonucu yazarsa işlem süresi kısalır diye düşünüyorum.

 

[warezamca]

Arkadaşlar aşağıdaki gibi bir kod yazdım ama sonuc sayfada #DEĞER hatası veriyor problem nerede acaba?
Private Sub CommandButton1_Click()
Sayfa3.Select
For p = 1 To 12
If Month(Calendar1.Value) = p Then
h = (3 * p) + 2
End If
Next
For x = 4 To Cells(65536, 1).End(xlUp).Row
If Cells(x, 1).Value = ComboBox1.Value Then
sonuc = Evaluate("=TOPLA.ÇARPIM((Sayfa4!$D$3:$D$37=Sayfa2!$Ax)*(Sayfa4!$F$3:$F$37<>"")*(Sayfa4!$M$3:$M$37 =Sayfa2!$C$1:$AJ$1))")
Cells(x, h).Value = sonuc
Sayfa1.Select
End If
Next
End Sub