topla çarpım makrosu

[kiran67]

kontrol sayfasının çok fazla formül var ve en ufak bir değişiklikte çok fazla bekletiyor. Düşeyara formüllerini yaptım ama Topla çarpım formülü ile eğer formüllerinin makrosunu yapamadım. Topla çarpımı bitirebilirsem Eğer formülü ile uğraşacaktım.

Kontrol sayfasında Q sütununun tamamında bu formül var ; TOPLA.ÇARPIM((I2>=İZİN!$H$2:$H$9998)*(I2<İZİN!$I$2:$I$9998)*(İZİN!$J$2:$J$9998))
R sütununda : EĞER(VE(O2>1;O2<9);0;Q2-P2)
S sütunu : EĞER(K2=L2;0;1)
V sütunu : EĞERHATA(0;EĞER(VE(N2=1;T2=0);M2-DÜŞEYARA(I2;PDKS!$M$2:$Q$30000;3;YANLIŞ);0))
w sütunu: EĞERHATA(0;EĞER(DÜŞEYARA(I2;'PDKS KART'!S:T;2;YANLIŞ)=1;1;0))
Y sutunu =EĞER(VE(O2<>"V";(DÜŞEYARA(I2;PDKS!M:S;7;YANLIŞ)=1));1;0)
z sutunu = EĞER(VE(DÜŞEYARA(I2;PDKS!M:S;7;YANLIŞ)<>1;O2="V");1;0)
AA sütunu : EĞER(VE(TOPLA.ÇARPIM((I2>=GÖREVLİ!$F$2:$F$600)*(I2<=GÖREVLİ!$G$2:$G$600)*(GÖREVLİ!$H$2:$H$600))=1;N2<>1);1;0)

yapmış olduğum makro da bu şekilde. Düşeyara olanlar çalışıyor ama Sondaki topla çarpım ile ilgili olan çalışmıyor. Başka bir yerden kopyalayıp uyarlamaya çalıştım

Option Explicit
Dim Sicil, puan1, puan2, düşeyara As Variant
Sub Getir()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Kontrol")
Set s2 = Sheets("Kontrol")
s2.Range("I2").Value = s1.Range("A2").Value & s1.Range("D2").Value

Sicil = Worksheets("Kontrol").Range("I2:I50").Value
puan1 = Worksheets("Kontrol").Range("N2:N50").Value
puan2 = Worksheets("Kontrol").Range("O2:N50").Value

düşeyara = Application.WorksheetFunction.VLookup(Sicil, Worksheets("PUAN").Range("M2:R90000"), 2, 0)
Worksheets("Kontrol").Range("J2:J50").Value = düşeyara

düşeyara = Application.WorksheetFunction.VLookup(puan1, Worksheets("kodlar").Range("A2:B24"), 2, 0)
Worksheets("Kontrol").Range("K2:K50").Value = düşeyara

düşeyara = Application.WorksheetFunction.VLookup(puan2, Worksheets("kodlar").Range("A2:B24"), 2, 0)
Worksheets("Kontrol").Range("L2:L50").Value = düşeyara

düşeyara = Application.WorksheetFunction.VLookup(Sicil, Worksheets("puan").Range("M2:R90000"), 3, 0)
Worksheets("Kontrol").Range("M2:M50").Value = düşeyara

düşeyara = Application.WorksheetFunction.VLookup(Sicil, Worksheets("PUAN").Range("M2:R90000"), 4, 0)
Worksheets("Kontrol").Range("N2:N50").Value = düşeyara

düşeyara = Application.WorksheetFunction.VLookup(Sicil, Worksheets("PUAN").Range("M2:R90000"), 5, 0)
Worksheets("Kontrol").Range("O2:O50").Value = düşeyara

düşeyara = Application.WorksheetFunction.VLookup(puan2, Worksheets("DEGİZİNKOD").Range("J5:L39"), 3, 0)
Worksheets("Kontrol").Range("P250").Value = düşeyara

düşeyara = Application.WorksheetFunction.VLookup(Sicil, Worksheets("PDKS").Range("M2:R90000"), 6, 0)
Worksheets("Kontrol").Range("X2:X50").Value = düşeyara



Set s1 = Sheets("İZİN")
Set s2 = Sheets("KONTROL")
Dim i As Integer

For i = 2 To s2.Range("Q10").End(3).Row

s2.Cells(i, "Q").Value = Evaluate("SUMPRODUCT(('" & s1.Name & "'!H2:H10000) * ('" & s1.Name & "'!I2:I10000)* ('" & s1.Name & "'!J2:J10000))")
Next


End Sub

 

[YUSUF44]

Böyle sorularda örnek dosya olmadan çözüme ulaşmak zor ancak gördüğüm kadarıyla topla çarpım kısmında şartları belirlememişsiniz.

s2.Cells(i, "Q").Value = Evaluate("SUMPRODUCT(('" & s1.Name & "'!H2:H10000=......) * ('" & s1.Name & "'!I2:I10000=......)* ('" & s1.Name & "'!J2:J10000))")

gibi.

 

[kiran67]

Aslında Topla çarpımın karşılığında çok eşleşmeli Vlook da kullanılabilir sanırım. Makrodan çok anlamadığım için bilemiyorum

 

[kiran67]

Böyle sorularda örnek dosya olmadan çözüme ulaşmak zor ancak gördüğüm kadarıyla topla çarpım kısmında şartları belirlememişsiniz.

s2.Cells(i, "Q").Value = Evaluate("SUMPRODUCT(('" & s1.Name & "'!H2:H10000=......) * ('" & s1.Name & "'!I2:I10000=......)* ('" & s1.Name & "'!J2:J10000))")

gibi.

Haklısınız kusura bakmayın

https://dosyam.org/32Wy/KONTROL__-_Kopya.xlsm

Kontrol sayfasında modül 3 Orda I2 sütununa sicil tarih açtım sicil ile tarihleri birleştirip aynı sicilde aynı tarihteki olayı bulabilmek için düşeyara formülü çalışsın diye. Fakat tarihi metin şeklinde birleştirdi makro da istediğim gibi olmuyor. Yani şu sonucu vermesini istiyorum mesela A2 : 21493 D2: 15.02.2021 A2&D2 verdiği sonuç formülde bu şekil oluyor 2149344242 ama makroda bunu vermiyor. Bunu da ben düşeyarada kullanmak için yaptım. Makroda çoklu eşleşmeli düşeyara vardır mutlaka.

 

[YUSUF44]

Dosya boyutunuz çok büyük. i7 işlemcili bilgisayarımın açabilmesi 2 dakika sürdü. Herhangi bir işlem yapsaydım muhtemelen çok daha uzun sürebilir ve excel donabilirdi.

Bu gibi büyük boyutlu dosyalarda topla.çarpım gibi formüller kullanmak pek uygun olmaz. Her ne kadar gönderdiğiniz dosyada formülleri değer dönüştürmüş olsanız da görünüşe göre dosyanızda birbirine bağımlı birçok formül kullanmışsınız. Kullanılan her formül excelin yavaş çalışmasına neden olur. Hele böyle 20 mb'lık bir dosyada çalışmak hiç kolay değildir. bu nedenle dosyanıza göre çözüm öneremiyorum.

Tarihleri formüllerde kullanmak için METNEÇEVİR formülünü kullanabilirsiniz. METNEÇEVİR(D2;"gg.aa.yyyy") gibi.

 

[kiran67]

Dosya boyutunuz çok büyük. i7 işlemcili bilgisayarımın açabilmesi 2 dakika sürdü. Herhangi bir işlem yapsaydım muhtemelen çok daha uzun sürebilir ve excel donabilirdi.

Bu gibi büyük boyutlu dosyalarda topla.çarpım gibi formüller kullanmak pek uygun olmaz. Her ne kadar gönderdiğiniz dosyada formülleri değer dönüştürmüş olsanız da görünüşe göre dosyanızda birbirine bağımlı birçok formül kullanmışsınız. Kullanılan her formül excelin yavaş çalışmasına neden olur. Hele böyle 20 mb'lık bir dosyada çalışmak hiç kolay değildir. bu nedenle dosyanıza göre çözüm öneremiyorum.

Tarihleri formüllerde kullanmak için METNEÇEVİR formülünü kullanabilirsiniz. METNEÇEVİR(D2;"gg.aa.yyyy") gibi.

Teşekkürler ilginiz için. Formüller çok yavaşlattığı makro kullanmayı düşünmüştüm ben de . Topla çarpım da kullanılan makro Evaluate SUMPRODUCT değil mi? Bunun kullanış şeklini öğrenmeye çalışıyorum. En azından bunu da makroya çevirebilirsem eğer olanları formül olarak bırakacağım.

 

[YUSUF44]

Evet sumproduct ama dizilimi tam yapmak sizi zorlayabilir. Önce de belirttiğim gibi kriterleri eklemelisiniz.

 

[kiran67]

TOPLA.ÇARPIM((I2>=İZİN!$H$2:$H$9998)*(I2<İZİN!$I$2:$I$9998)*(İZİN!$J$2:$J$9998)) Bu formül için aşağıdaki makroyu kullandım ama çalışmadı. Açıkcası ;
" Dim i As Integer For i = 2 To s2.Range("Q10").End(3).Row" bunun ne anlama geldiğini bilmiyorum. Başka bir yerden kopyalayıp uyarlamaya çalıştım.

Set s1 = Sheets("İZİN")
Set s2 = Sheets("KONTROL")
Dim i As Integer

For i = 2 To s2.Range("Q10").End(3).Row

s2.Cells(i, "Q").Value = Evaluate("SUMPRODUCT(('" & s2.Name & "'I2:I10'">= '"& s1.Name & "'!H2:H10000) * ('" & s2.Name & "'I2:I10'"<'" & s1.Name & "'!I2:I10000)* ('" & s1.Name & "'!J2:J10000))")

 

[YUSUF44]

İlk formülünüzde I2 iken makroda neden I2:I10 olarak kullanmak istiyorsunuz?

 

[kiran67]

İlk formülünüzde I2 iken makroda neden I2:I10 olarak kullanmak istiyorsunuz?

Devam eden hücrelerin hepsinde hesaplamasını istiyorum. Bunun için ne kullanabilirim.

 

[YUSUF44]

Şu şekilde olmalı zannımca:

s2.Cells(i, "Q").Value = Evaluate("SUMPRODUCT(('" & s2.Name & "'I" & i & "'">= '"& s1.Name & "'!H2:H10000) * ('" & s2.Name & "'I" & i & "'"<'" & s1.Name & "'!I2:I10000)* ('" & s1.Name & "'!J2:J10000))")

 

[kiran67]

makro kaydet yaptım bu şekilde çıkıyor hücrelere de formülleri getirdi. Bu da fark etmez herhalde hız olarak bişey değiştirir mi dersiniz ?

Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((RC[-8]>=İZİN!R2C8:R9998C8)*(RC[-8]<İZİN!R2C9:R9998C9)*(İZİN!R2C10:R9998C10))"
Range("Q2").Select
Selection.AutoFill Destination:=Range("Q2:Q50"), Type:=xlFillDefault

 

[YUSUF44]

Bu şekilde hücrede formül kalacağı için sürekli olarak hesaplama yapar, istediğiniz sonucu elde edemezsiniz, yavaşlık sorunu devam eder.