Evaluate("Sumproduct(....

[emrexcel123]

arkadaşlar ve üstadlar ii çalışmalar ve günaydın
ekte yer alan dosyadaki BAKIYE sayfasında banka isimleri ve hesap numaraları yer alıyor."BANKA-DATE-DEGER" sayfalarında ise bu bankalara ait hareketler bulunuyor ve aynı zamanda bu üç sayfadaki değerler birebir aynı yani eş değerli gidiyor aynı satırda aynı sütun sayısı kadar değer yer alıyor.BAKIYE sayfasında 3.-4.-5. sütunlarda ilgili formülleri göreceksiniz bu şekilde istediğim verileri alabiliyorum fakat takdir edersiniz ki bu veriler 1000 sütuna kadar devam edebilir böyle olunca Excel'in hesaplaması 20 dk kadar alıyor fakat makro ile saniyeler içerisinde hallediyor bu formülü makro diliyle yazmayı başaramadım yardımcı olacak arkadaşlara teşekkür ederim...
(başlıkta bir sorun varsa affımı kabul edin en uygun bunu düşündüm :roll

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları, modül sayfana ekleyip, sayfadaki butona bağlarsan, sanırım problemin çözülecektir.

Sub tablo_olustur()

Set shbky = Sheets("BAKIYE")
Set shbnk = Sheets("BANKA")
Set shdat = Sheets("DATE")
Set shdgr = Sheets("DEGER")

sonsatir = shbnk.Cells(65536, 1).End(xlUp).Row
'bu bölüm banka ve bakiye sütunlarını oluşturur
For i = 2 To sonsatir
shbky.Cells(i, 2) = shbnk.Cells(i, 1)
sonsutun = shdat.Cells(i, 256).End(xlToLeft).Column
For j = 1 To sonsutun
' bkye = 0
If shdat.Cells(i, j) <= Date Then
bkye = bkye + shdgr.Cells(i, j)
End If
Next j
shbky.Cells(i, 3) = bkye
bkye = 0
'bu bölüm bekleyen sütununu oluşturur
For z = 1 To sonsutun
If shdat.Cells(i, z) > Date Then
bkly = bkly + shdgr.Cells(i, z)
End If
Next z
shbky.Cells(i, 4) = bkly
bkly = 0
'bu bölüm genel bakiyeyi verir
shbky.Cells(i, 5) = shbky.Cells(i, 3) + shbky.Cells(i, 4)
Next i

Set shbky = Nothing
Set shbnk = Nothing
Set shdat = Nothing
Set shdgr = Nothing

End Sub

 

[emrexcel123]

sütunda yazan verilere göre

arkadaşım çok güzel olmuş eline sağlık ancak bakiye sayfasında yer alan "b" sütunundaki verilere toplam alması mümkün mü ? yani aynı olan kayıtları alt alta sıralamasın yani geneli alsın...

 

[Ferhat Pazarçevirdi]

Bakiye "B" sutununda olanlar "Hesap No"lar de&#287;il mi? Nas&#305;l toplam alaca&#287;&#305;z ? En alta s&#252;tunlar&#305;n toplam&#305;n&#305; m&#305; almay&#305; m&#305; kastediyorsun? Tam olarak anlamad&#305;m.

 

[emrexcel123]

arkadaşım şimdi sen tüm verileri alıp tarihlere göre bakiyesini veriyosun ve de b sütununa da tüm hesap nolarını yazıyosun ya işte aynı hesaptan birden çok varsa onları alt alta değil de tek satırda toplaması mümkün mü ? örneğin 1111 hesaptan 6 satırda farklı değerler var onları bakiye sayfasında tek satırda yani 1111 hesabının toplamı 6 satırın toplamı olacak şekilde arkadaşım...

 

[emrexcel123]

arkadaşım sorunumu çözdüm fakat kulağımı tersten tutarak ancak güzel çalışıyor yardımların için sana minnettarım arkadaşım çok sağol bu akşam saatinde aklını yordun aklına sağlık kardeşim

 

[Ferhat Pazarçevirdi]

Çözdüğüne sevindim. Eğer yine de başka bir şey denemek istersen, aşağıdaki kodları da inceleyebilirsin.

Sub tablo_olustur2()
Set shbky = Sheets("BAKIYE")
Set shbnk = Sheets("BANKA")
Set shdat = Sheets("DATE")
Set shdgr = Sheets("DEGER")

Range("BAKIYE!B2:c1000").ClearContents
sonsatir = shbnk.Cells(65536, 1).End(xlUp).Row

For i = 1 To sonsatir
If WorksheetFunction.CountIf(Range("BANKA!A2:A" & i + 2), shbnk.Cells(i + 1, 1)) = 1 Then
sonsatirbky = shbky.Cells(65536, 2).End(xlUp).Row
shbky.Cells(sonsatirbky + 1, 2) = shbnk.Cells(i + 1, 1)
End If
Next

sonsatirbky = shbky.Cells(65536, 2).End(xlUp).Row

For i = 1 To sonsatirbky 'bakiye sayfasındaki hesap no
For j = 2 To sonsatir 'banka sayfasındaki hesap no
If shbky.Cells(i + 1, 2) = shbnk.Cells(j, 1) Then 'bakiyedeki hesapno ile, bankadaki hesap no aynı ise
sonsutun = shdat.Cells(j, 256).End(xlToLeft).Column 'date tablosunun son veri işlenmiş sütunu
For k = 1 To sonsutun
If shdat.Cells(j, k) <= Date Then
bkye = bkye + shdgr.Cells(j, k)
Else
bkly = bkly + shdgr.Cells(j, k)
End If
Next k
End If

Next j
shbky.Cells(i + 1, 3) = bkye
shbky.Cells(i + 1, 4) = bkly
bkye = 0
bkly = 0
Next i



Set shbky = Nothing
Set shbnk = Nothing
Set shdat = Nothing
Set shdgr = Nothing
End Sub

iyi akşamlar,