topla çarpım formül yerine makro

[edit_by_salih]

ekteki dosyada yapmak istediğimi aşağıdaki formül ile yapıyorum fakat bu işlemi makro ile yapmak mümkünmü


TOPLA.ÇARPIM(--(OCAK!$D$4:$D$5016>=G$1);--(OCAK!$D$4:$D$5016<=G$2);--(OCAK!$C$4:$C$5016=$E4);--(OCAK!$K$4:$K$5016))

 

[asi_kral]

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub aylık_topla()
Dim S1 As Worksheet, S2 As Worksheet
Dim STR As Long, STN As Long
Set S1 = Sheets("FARK")
For STN = 4 To S1.Cells(3, Columns.Count).End(xlToLeft).Column
If S1.Cells(3, STN) <> Empty Then
Set S2 = Sheets(S1.Cells(3, STN).Text)
For STR = 4 To S1.Range("B" & Rows.Count).End(xlUp).Row
If S1.Cells(STR, "B") <> Empty Then
S2.Range("A3:L" & Rows.Count).AutoFilter 3, S1.Cells(STR, "B")
S2.Range("A3:L" & Rows.Count).AutoFilter 4, ">=" & CDbl(S1.Cells(1, STN)), _
xlAnd, "<=" & CDbl(S1.Cells(2, STN))
S1.Cells(STR, STN) = WorksheetFunction.Subtotal(9, _
S2.Range("K:K"))
S2.Range("A3:L" & Rows.Count).AutoFilter
End If: Next: End If: Next
End Sub

Not : Sayfa isimleri ile aylar birbiri ile aynı olmalıdır. Mesela Dosyanızda SUBAT sayfasını ŞUBAT AGUSTOS sayfasını AĞUSTOS olarak değiştirin.

 

[edit_by_salih]

Sayın asi_kral çok teşekkür ederim

 

[asi_kral]

Sayın asi_kral çok teşekkür ederim

Kolay Gelsin.