• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Topla.Çarpım fonksiyonunu yerine "Scripting.Dictionary" nesnesini nasıl kullanırız

P

programer

Katılım
26 Mayıs 2005
Mesajlar
609
Excel Vers. ve Dili
Office 2022 - Türkçe
Topla.Çarpım fonksiyonunu yerine "Scripting.Dictionary" nesnesini nasıl kullanırız

Arkadaşlar herkese merhaba. Öncelikle forumda baya bi araştırma yaptım "Scripting.Dictionary" nesnesi ile ilgili ama uygun bir örnek bulamadım. Nesnenin nasıl kullanıldığı hakkındada çok bilgim yok. Aşağıdaki kodları Topla.Çarpım'ın makro hali ile yaptım ama satır sayısı arttımı kodlar yavaş çalışıyor. Yapmak istediğimi özetleyecek olursam, Hareket sayfasında ListView1'den seçtiğim firmanın yapılan giriş çıkış hareketlerine göre TL, USD, EURO, bakiyelerini almak istiyorum.


Kod: 
Sub Bakiye()
sRangeA = "Hareket!B2:B65536"
sRangeB = "Hareket!E2:E65536"
sRangeC = "Hareket!J2:J65536"
sRangeD = "Hareket!K2:K65536"
sRangeE = "Hareket!L2:L65536"

Criter1 = Stok_Bul.ListView1.SelectedItem.ListSubItems(1).Text
BCriter1 = "TL"
BCriter2 = "USD"
BCriter3 = "EURO"
        
HBCriter1 = "Satış_Çıkış"
HBCriter2 = "Cek_Odeme"
HBCriter3 = "Kasa_Odeme"
        
HACriter1 = "Giriş_Alış"
HACriter2 = "Cek_Tahsilat"
HACriter3 = "Kasa_Tahsilat"
        
TLb = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter1 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HBCriter1 & """)*(" & sRangeD & "))")
TLb1 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter1 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HBCriter2 & """)*(" & sRangeE & "))")
TLb2 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter1 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HBCriter3 & """)*(" & sRangeE & "))")

USDb = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter2 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HBCriter1 & """)*(" & sRangeD & "))")
USDb1 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter2 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HBCriter2 & """)*(" & sRangeE & "))")
USDb2 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter2 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HBCriter3 & """)*(" & sRangeE & "))")

EUROb = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter3 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HBCriter1 & """)*(" & sRangeD & "))")
EUROb1 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter3 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HBCriter2 & """)*(" & sRangeE & "))")
EUROb2 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter3 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HBCriter3 & """)*(" & sRangeE & "))")

TLa = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter1 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HACriter1 & """)*(" & sRangeD & "))")
TLa1 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter1 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HACriter2 & """)*(" & sRangeE & "))")
TLa2 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter1 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HACriter3 & """)*(" & sRangeE & "))")

USDa = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter2 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HACriter1 & """)*(" & sRangeD & "))")
USDa1 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter2 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HACriter2 & """)*(" & sRangeE & "))")
USDa2 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter2 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HACriter3 & """)*(" & sRangeE & "))")

EUROa = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter3 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HACriter1 & """)*(" & sRangeD & "))")
EUROa1 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter3 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HACriter2 & """)*(" & sRangeE & "))")
EUROa2 = Evaluate("=SumProduct((" & sRangeC & "=""" & BCriter3 & """)*(" & sRangeB & "=""" & Criter1 & """)*(" & sRangeA & "=""" & HACriter3 & """)*(" & sRangeE & "))")

Worksheets("Cek_Fisi").Unprotect
Worksheets("Cek_Fisi").[F2].Value = (TLb + TLb1 + TLb2) - (TLa + TLa1 + TLa2)
Worksheets("Cek_Fisi").[F3].Value = (USDb + USDb1 + USDb2) - (USDa + USDa1 + USDa2)
Worksheets("Cek_Fisi").[F4].Value = (EUROb + EUROb1 + EUROb2) - (EUROa + EUROa1 + EUROa2)
Worksheets("Cek_Fisi").Protect
End Sub
 
Merhaba
Özet tablo kullanın.
Ya da makro ile yapmaya devam etmek istiyorum diyorsanız, makro ile özet tablo oluşturun.
 
sayın uzmanamele, bu kodları giriş çıkış fişlarinde firmayı seçtikten sonra bakiyesini anlık görmek için kullanıyorum. özet tabo burada işimi görmüyor.
 
örnek dosya ekliyorum

arkadaşlar söylediklerimin daha anlaşılır olması için örnek dosyada ekliyorum
 

Ekli dosyalar

herkese iyi akşamlar arkadaşlar dünden beri bakıyorum ama bir türlü sonuca varamadım. yardımcı olabilirmisiniz.
 
Merhaba,

Belirttiğiniz gibi TOPLA.ÇARPIM fonksiyonu çok satırlı dosyalarda ağır çalışmaya sebep olur.

Filtre özelliğini kullanarak verilerinizi ssüzdükten sonra ekranda görünen satırlara ALTTOPLAM formülü ile değerlendirerek sonuca daha hızlı gidebilirsiniz.

Sanıyorum bu işlemi siz yapabilirsiniz. Deneyin eğer yapamazsanız yardımcı olalım.
 
Arkadaşlar yardım ve önerileriniz için teşekkür ederim. forumda araştırmalara devam ederken aşağıdaki kodları denedim ve topla.çarpımdan daha hızlı çalıştığını gördüm ve kendi kodlarıma uyarladım. gayet güzel ve hızlı çalışıyor. ama kayıt sayısı artınca nasıl çalışır bilmiyorum.


Kod: 
Sub Bakiye()
On Error Resume Next

Dim bak As String
Dim bak1 As String
Dim bak2 As String
Dim bak3 As String
Dim bak4 As String

Dim j, k As Byte

j = 2
Do While Sheets("Hareket").Cells(j, 1) <> ""
bak = Sheets("Hareket").Cells(j, 2)
bak1 = Sheets("Hareket").Cells(j, 5)
bak2 = Sheets("Hareket").Cells(j, 11)
bak3 = Sheets("Hareket").Cells(j, 12)
bak4 = Sheets("Hareket").Cells(j, 10)

If bak1 = [B1].Value Then

If bak = "Satış_Çıkış" And bak4 = "TL" Then
For k = 1 To 1
HBCriter1 = Val(HBCriter1) + Val(bak2)
Next
ElseIf bak = "Satış_Çıkış" And bak4 = "USD" Then
For k = 1 To 1
USDHBCriter1 = Val(HBCriter1) + Val(bak2)
Next
ElseIf bak = "Satış_Çıkış" And bak4 = "EURO" Then
For k = 1 To 1
EUROHBCriter1 = Val(HBCriter1) + Val(bak2)
Next
ElseIf bak = "Giriş_Alış" And bak4 = "TL" Then
For k = 1 To 1
HACriter1 = Val(HACriter1) + Val(bak2)
Next
ElseIf bak = "Giriş_Alış" And bak4 = "USD" Then
For k = 1 To 1
USDHACriter1 = Val(HACriter1) + Val(bak2)
Next
ElseIf bak = "Giriş_Alış" And bak4 = "EURO" Then
For k = 1 To 1
EUROHACriter1 = Val(HACriter1) + Val(bak2)
Next
End If

If bak = "Cek_Odeme" And bak4 = "TL" Then
For k = 1 To 1
HBCriter2 = Val(HBCriter2) + Val(bak3)
Next
ElseIf bak = "Cek_Odeme" And bak4 = "USD" Then
For k = 1 To 1
USDHBCriter2 = Val(HBCriter2) + Val(bak3)
Next
ElseIf bak = "Cek_Odeme" And bak4 = "EURO" Then
For k = 1 To 1
EUROHBCriter2 = Val(HBCriter2) + Val(bak3)
Next
ElseIf bak = "Cek_Tahsilat" And bak4 = "TL" Then
For k = 1 To 1
HACriter2 = Val(HACriter2) + Val(bak3)
Next
ElseIf bak = "Cek_Tahsilat" And bak4 = "USD" Then
For k = 1 To 1
USDHACriter2 = Val(HACriter2) + Val(bak3)
Next
ElseIf bak = "Cek_Tahsilat" And bak4 = "EURO" Then
For k = 1 To 1
EUROHACriter2 = Val(HACriter2) + Val(bak3)
Next
End If

If bak = "Kasa_Odeme" And bak4 = "TL" Then
For k = 1 To 1
HBCriter3 = Val(HBCriter3) + Val(bak3)
Next
ElseIf bak = "Kasa_Odeme" And bak4 = "USD" Then
For k = 1 To 1
USDHBCriter3 = Val(HBCriter3) + Val(bak3)
Next
ElseIf bak = "Kasa_Odeme" And bak4 = "EURO" Then
For k = 1 To 1
EUROHBCriter3 = Val(HBCriter3) + Val(bak3)
Next
ElseIf bak = "Kasa_Tahsilat" And bak4 = "TL" Then
For k = 1 To 1
HACriter3 = Val(HACriter3) + Val(bak3)
Next
ElseIf bak = "Kasa_Tahsilat" And bak4 = "USD" Then
For k = 1 To 1
USDHACriter3 = Val(HACriter3) + Val(bak3)
Next
ElseIf bak = "Kasa_Tahsilat" And bak4 = "EURO" Then
For k = 1 To 1
EUROHACriter3 = Val(HACriter3) + Val(bak3)
Next
End If

End If
    j = j + 1
Loop

Worksheets("Cek_Fisi").Unprotect
Worksheets("Cek_Fisi").[F2].Value = (HBCriter1 + HBCriter2 + HBCriter3) - (HACriter1 + HACriter2 + HACriter3)
Worksheets("Cek_Fisi").[F3].Value = (USDHBCriter1 + USDHBCriter2 + USDHBCriter3) - (USDHACriter1 + USDHACriter2 + USDHACriter3)
Worksheets("Cek_Fisi").[F4].Value = (EUROHBCriter1 + EUROHBCriter2 + EUROCriter3) - (EUROHACriter1 + EUROHACriter2 + EUROHACriter3)
Worksheets("Cek_Fisi").Protect
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst