topla çarpım makro kodunun vba ya çevrilmesi

[kemal turan]

merhaba,
Projemde kullandığım TOPLAÇARPIM ihtiyacımı makro kodu ile yapıp daha sonra sutun değer olarak kaydediyorum.
Dosyada veri az olduğu için kasmadan çalışıyor fakat ilerde sıkıntı çıkaracağını düşünüyorum.
Ek dosyada kod içerisinde olan ETOPLA kodu mantığı ile TOPLAÇARPIM için uğraştım olmadı.
makro kodunu vba ya çevirecek kod rica ediyorum.
Teşekkür ederim

 

[Orion1]

Boş dosya yollamışsınız.

 

[kemal turan]

özür dilerim
dosyayı yeniledim

 

[vardar07]

Deneyiniz.

Sub tahsılat1()
Application.ScreenUpdating = False
Sheets("ODEMEPLANIOZET").Select
[J2:J10000].ClearContents
son = Cells(Rows.Count, "g").End(3).Row
With Range("I2:I" & son)
.Formula = "=SUMIF(KASA!I:I,E2,KASA!r:r)"
'.Value = .Value
End With
Range("J2:J65536").ClearContents
For i = 2 To Cells(65536, "A").End(xlUp).Row
'Cells(i, "J").Value = WorksheetFunction.Sum(Range("h" & i) - Range("ı" & i))
Cells(i, "J").FormulaR1C1 = "=SUM(RC[-2]-RC[-1])"
Next i
Range("K2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-5]<>"""",SUMPRODUCT((ODEMEPLANI!R2C5:R230C5=ODEMEPLANIOZET!RC[-6])*(ODEMEPLANI!R2C6:R230C6=ODEMEPLANIOZET!RC[-5])*(ODEMEPLANI!R2C12:R230C12=""GECİKEN ÖDEME"")*(ODEMEPLANI!R2C11:R230C11)),"""")"
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K" & son)
    'Range("K2:K65536").Select
    'Columns("K:K").Select
    'Selection.Copy
    'Columns("K:K").Select
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    '    :=False, Transpose:=False
    'Range("K1").Select
    'Application.CutCopyMode = False
    
    Application.ScreenUpdating = True
End Sub

 

[kemal turan]

merhaba Sn Vardar,
Çözüm kodunuz çalışıyor.Teşekkür ederim.
Fakat benim var olan VERİ AL düğmesine basıldığında çalışan kod ile küçük farklılıklar içeriyor.Çözüm yolu aynı gibi.
Ben "WorksheetFunction.SumIf" şeklinde başlayan bir kod olması için araştırma yaptım.
Bazıları çalıştı. fakat with ile başlayan satırında "WorksheetFunction.SumIf" içeren , end with ile biten bir kod olabileceğini düşünüyorum.
Bu e topla kodu gibi

[J2:J10000].ClearContents
son = Cells(Rows.Count, "g").End(3).Row
With Range("I2:I" & son)
.Formula = "=SUMIF(KASA!I:I,E2,KASA!r:r)"
'.Value = .Value
End With

ilginize teşekkür ediyorum.

 

[vardar07]

Formülleri görmek isterseniz .Value = .Value satırlarının önüne tek tırnak koyun

Sub tahsılat1()
Application.ScreenUpdating = False
Set so = Sheets("ODEMEPLANI")
Sheets("ODEMEPLANIOZET").Select
son = Cells(Rows.Count, "g").End(3).Row
Range("I2:K" & son).ClearContents
With Range("I2:I" & son)
.Formula = "=SUMIF(KASA!I:I,E2,KASA!r:r)"
.Value = .Value
End With
With Range("J2:J" & son)
.Formula = "=SUM(H2-I2)"
.Value = .Value
End With
With Range("K2:K" & son)
.Formula = "=SUMIFS(ODEMEPLANI!K:K,ODEMEPLANI!E:E,E2,ODEMEPLANI!F:F,F2,ODEMEPLANI!L:L,""GECİKEN ÖDEME"")"
.Value = .Value
End With
    Application.ScreenUpdating = True
End Sub

 

[kemal turan]

Merhaba Sn Vardar,
Çok teşekkür ederim.
Emeğinize sağlık, hakkınızı helal ediniz.
Selametle kalınız

 

[vardar07]

Rica ederim işiniz görüldüyse sorun yok.