Sumproduct(topla.çarpım) formülü VBA nasıl uyarlarız

[asterix1234]

Birden fazla kritere uyanların toplamını almak (VBA)

Merhaba,

Ekte bir servis formum var, amacım değişik semtlere giden servisleri; hangi departmandan kaç kişi kullanıyor.
Fakat servisleri kullanan birden fazla firma var onun için Ek' teki örneğime topla.çarpım ile bir formüller yazdım. İncelemenizi rica ediyorum.
Ben formüller ile (Örnekte sarı ile işaretlediğim satırlar) bu işe yapmaya kalktığımda dakikalar geçiyor, bu sebeple yardımcı olmanızı rica ediyorum..

 

[Levent Menteşoğlu]

Peki 2.satırdaki firmanın adı mutlaka oradamı durması gerekiyor. Örneğin en alta yada en üste alınamazmı? Sorunuz bana fonksiyonlarlada çözülebilir gibi geldi.

 

[asterix1234]

Peki 2.satırdaki firmanın adı mutlaka oradamı durması gerekiyor. Örneğin en alta alınamazmı? Sorunuz bana fonksiyonlarlada çözülebilir gibi geldi.

Hocam, fonsiyonlar ile çözmeye kalktığımda malum her sarı satırda ve hücrede yazdığımda çok fazla formül oluyor buda user form ile çalıştığımda çok ağırlaştırıyor.

2. satırdaki firmayı ayrı hesaplamam gerekiyor diğerlerine dahil etmeden

 

[asterix1234]

Levent Hocam,

"Transay Masraf" sayfasında sarı ile işaretlenen alanların tamamında yapmak istediğim şey;

topla.çarpım ile yapmaktayım istediğimi fakat userforma aldığımda sayfayı formüllerin çok fazla olması ağırlaştırıyor onun için kod yazmak düşüncesindeyim.

Örnek olarak C3:R3 arasını açıklayayım. Transay Masraf S3 hücresi 0 dan büyük ise macro çalışsın bundan sonra, C3 ile Q3 arasındaki hücreler Zor Kimya - Zoom - B&B İnform - Saran Tekstil - Bedir Tekstil (List! A1;A3;A4;A5;A6 arasında yer alan) frimalarında çalışanların 'Transay Masraf'!A3 hücresinde yer alan servis adına göre uyanları 'Transay Masraf'!C2:Q2 arasındaki da yer alanların sayısını vermek.

R2 de yer firmada yer alan personeller departman gözetmeksizin A3 hücresinde yer alan servis mevcudunu verecek.


Ben bunu tüm sarı ile işaretlenmiş satırlarda yapmak istiyorum..

Not: Ben formülü yazarken firma isimlerini List adlı sayfadan alıyorum buradaki bilgiler sabit mümkünse macroda burdan sort yapsın..

Aslında yapmak istediğimi formüller ile yaptım Transay Masraf adlı sayfanın ilk satırında görebilirisiniz bunu macro ile sade bir kod yazarak tüm sarı satırları içeren hücrelerde yapmak düşüncesindeyim..

 

[Levent Menteşoğlu]

Aşağıdaki kodu "transay masraf" isimli sayfada oluşturacağınız bir butona bağlayarak çalıştırın.

Sub tabloyudoldur()
Set s1 = Sheets("bilgiler")
Set s2 = Sheets("transay masraf")
If s1.AutoFilterMode = false Then s1.[a1:gy65536].AutoFilter
For sat = 3 To 71 Step 4
For sut = 3 To 17
s1.[a1:gy65536].AutoFilter Field:=207, Criteria1:=s2.Cells(sat, "a")
s1.[a1:gy65536].AutoFilter Field:=11, Criteria1:=s2.Cells(2, sut)
say1 = WorksheetFunction.Subtotal(103, s1.[a:a])
s1.[a1:gy65536].AutoFilter Field:=1, Criteria1:="Armed"
say2 = WorksheetFunction.Subtotal(103, s1.[a:a])
If say1 - say2 > 0 Then s2.Cells(sat, sut) = say1 - say2
If say2 > 0 Then s2.Cells(sat, 18) = say2
s1.ShowAllData
Next
Next
s1.[a1:gy65536].AutoFilter
End Sub

 

[asterix1234]

Aşağıdaki kodu "transay masraf" isimli sayfada oluşturacağınız bir butona bağlayarak çalıştırın.

Sub tabloyudoldur()
Set s1 = Sheets("bilgiler")
Set s2 = Sheets("transay masraf")
If s1.AutoFilterMode = false Then s1.[a1:gy65536].AutoFilter
For sat = 3 To 71 Step 4
For sut = 3 To 17
s1.[a1:gy65536].AutoFilter Field:=207, Criteria1:=s2.Cells(sat, "a")
s1.[a1:gy65536].AutoFilter Field:=11, Criteria1:=s2.Cells(2, sut)
say1 = WorksheetFunction.Subtotal(103, s1.[a:a])
s1.[a1:gy65536].AutoFilter Field:=1, Criteria1:="Armed"
say2 = WorksheetFunction.Subtotal(103, s1.[a:a])
If say1 - say2 > 0 Then s2.Cells(sat, sut) = say1 - say2
If say2 > 0 Then s2.Cells(sat, 18) = say2
s1.ShowAllData
Next
Next
s1.[a1:gy65536].AutoFilter
End Sub

Hocam çok teşekkür ederim, butona bağlayıp deniyeceğim. fakat ben Bilgiler sayfasını multipage de veri almak için diğer listbox/listviewlerde de kullanıyorum birde kullandığım Bilgiler sayfası A:IV arasında verilerim var AUTOFILTER olayı ileri dönük sorun çıkarırı mı ?

 

[Levent Menteşoğlu]

Herhangi bir sorun çıkartmaz. Sadece çalışmanıza uyarlamanız gerekebilir.

 

[asterix1234]

Herhangi bir sorun çıkartmaz. Sadece çalışmanıza uyarlamanız gerekebilir.

Hocam, 3 büyük sorunum var...
1. userformu çalıştırdığımda bilgiler sayfası autofilter olduğundan ve sizin yazdığınız kodlarda atufilter yeniden aktif hale getirmesi sebebiyle sorun çıkarıyor.

2. kodlar Transay masraf sayfasındaki ilgili satırların sonundaki S sütunundaki değer 0 ise kodlar çalışmamasını rica etmiştim ama oradaki değere bakmadan kodlar tüm satırlarda çalışıyor.

3. benim orjinal bilgiler sayfasındaki verileri A:IV kolonları arasında ve yaklaşık300 - 400 satır ve tamamı dolu bu sebeple yazdığınız kodları uygulamak istediğimde sonuç almam bir hayli zaman alıyor.


bu sıkıntıları nasıl gideririz.. teşekkür ederim..

 

[Levent Menteşoğlu]

1- Nasıl bir sorun çıkartıyor, sadece işlem sonunda autofilteri kaldırır, isterseniz bu iptal edilebilir.

2- S sütununa değer el ilemi giriliyor.

3- A:IV arasına kodları nasıl uygulayacağınızı anlayamadım. Kod dosyanızda verdiğiniz, A,K ve GY sütunlarına göre işlem yapmaktadır.

 

[asterix1234]

1- Nasıl bir sorun çıkartıyor, sadece işlem sonunda autofilteri kaldırır, isterseniz bu iptal edilebilir.

2- S sütununa değer el ilemi giriliyor.

3- A:IV arasına kodları nasıl uygulayacağınızı anlayamadım. Kod dosyanızda verdiğiniz, A,K ve GY sütunlarına göre işlem yapmaktadır.

1. için Ok. hocam
2. S sütuna veri formülle alınıyor
3. A,K,GY sütunlarına göre işlem yapılıyor doğru, fakat sizin yazdığınız kodu kendime uyarladığımda (kensi dosyamda A:IV arasındaki kolonlarda veriler var 300-400 satır) sanırım kolonlardaki verilerin dolu olması işlemi çok ama çok uzatıyor bende anlamadım hocam

bu auto filtre ile olmak zorundamı daha başka nasıl bir çözüm oluşturabiliriz bu enkolayımı
diğer soruda verdiğim örnekte Armed adlı firmayı ayrı hesaplatıyorduk bunu kendime uyarladığımda Armed değilde ENKA A.Ş olarak kodda değişiklik yaptım kodun baktığı kolondoki ismide ENKA A.Ş olarak değiştirdim ama nedense her satırda ENKA A.Ş mevcudu için 1 değerini veriyor

 

[Levent Menteşoğlu]

2.sorunuzun çözümü için kodu aşağıdaki ile değiştirin. Çok sayıda veri ile deneme fırsatım olmadığı için nasıl bir hızla çalışacağını bilmiyorum. Hızı arttırmak için kod içine "Application.ScreenUpdating = False" satırını ilave ettim. Bunun dışında ADO ile daha hızlı bir çözümde bulunabilir. Ado ile ilgili bir kod örneği hazırlamak biraz zaman alır. İlk fırsatta yapmaya çalışırım. ENKA A.Ş. konusunda tek ihtimal yazım farkı olmasıdır, buna dikkat edin.

Sub tabloyudoldur()
Application.ScreenUpdating = False
Set s1 = Sheets("bilgiler")
Set s2 = Sheets("transay masraf")
If s1.AutoFilterMode = False Then s1.[a1:IV65536].AutoFilter
For sat = 3 To 71 Step 4
If s2.Cells(sat, "s") = 0 Then GoTo 10
For sut = 3 To 17
s1.[a1:IV65536].AutoFilter Field:=207, Criteria1:=s2.Cells(sat, "a")
s1.[a1:IV65536].AutoFilter Field:=11, Criteria1:=s2.Cells(2, sut)
say1 = WorksheetFunction.Subtotal(103, s1.[a:a])
s1.[a1:IV65536].AutoFilter Field:=1, Criteria1:="Armed"
say2 = WorksheetFunction.Subtotal(103, s1.[a:a])
If say1 - say2 > 0 Then s2.Cells(sat, sut) = say1 - say2
If say2 > 0 Then s2.Cells(sat, 18) = say2
s1.ShowAllData
Next
10 Next
s1.[a1:IV65536].AutoFilter
End Sub

 

[asterix1234]

2.sorunuzun çözümü için kodu aşağıdaki ile değiştirin. Çok sayıda veri ile deneme fırsatım olmadığı için nasıl bir hızla çalışacağını bilmiyorum. Hızı arttırmak için kod içine "Application.ScreenUpdating = False" satırını ilave ettim. Bunun dışında ADO ile daha hızlı bir çözümde bulunabilir. Ado ile ilgili bir kod örneği hazırlamak biraz zaman alır. İlk fırsatta yapmaya çalışırım. ENKA A.Ş. konusunda tek ihtimal yazım farkı olmasıdır, buna dikkat edin.

Sub tabloyudoldur()
Application.ScreenUpdating = False
Set s1 = Sheets("bilgiler")
Set s2 = Sheets("transay masraf")
If s1.AutoFilterMode = False Then s1.[a1:IV65536].AutoFilter
For sat = 3 To 71 Step 4
If s2.Cells(sat, "s") = 0 Then GoTo 10
For sut = 3 To 17
s1.[a1:IV65536].AutoFilter Field:=207, Criteria1:=s2.Cells(sat, "a")
s1.[a1:IV65536].AutoFilter Field:=11, Criteria1:=s2.Cells(2, sut)
say1 = WorksheetFunction.Subtotal(103, s1.[a:a])
s1.[a1:IV65536].AutoFilter Field:=1, Criteria1:="Armed"
say2 = WorksheetFunction.Subtotal(103, s1.[a:a])
If say1 - say2 > 0 Then s2.Cells(sat, sut) = say1 - say2
If say2 > 0 Then s2.Cells(sat, 18) = say2
s1.ShowAllData
Next
10 Next
s1.[a1:IV65536].AutoFilter
End Sub

Hocam Gecenin bu saatinde bile yardımlarınızı esirgemediğiniz için binlerce teşekkürler, ADO ile çözüm önerinizi inşallah vakit bulursanız yapmanız dileğiyle iyi geceler..

 

[asterix1234]

Levent hocam, son sütunun sorgusu yani "Armed" firmasının sorgusunu kod sayfasından ve ilgili sayfalarda "ENKA DTAŞ" olarak v.b. değiştirsek de kodları çalıştırdığımızda her satıra 1 değerini koyuyor. anlamadım ama neden böyle yapıyor ??

 

[asterix1234]

Levent hocam, bakabildiniz mi (ADO ile çözüm) ve ben hala Armed (firma ismine göre sorgulama) olayını çözebilmiş değilim, birde gerçekten çok ağır çalışıyor sorgulama yapılan alanda (bilgiler) sayfada formülde yokki bukadar uğraştırsın ama çok ağır en azından 2,5 dk bekliyorum sonuç almak için anlamadım ben bunu

 

[asterix1234]

Arkadaşlar, ekteki dosyaya göre Levent Beyin vermiş olduğu kodları kendi dosyama ilave edip çalıştırdığımda çok ağırlaşıyor sebebi ne olabilir yada ADO ile çözümü konusunda yardım edebilirmisiniz. Teşeküür ederim..