Access veritabanından koşullu aktarma

[bluefalcon]

Arkadaşlar merhaba,

Ekli dosyalardan da göreceğiniz üzere, bir rapor oluşturmam gerekiyor ancak mantığını oturtamadım bir türlü, desteğinizi rica ediyorum. "Book2.xlsm" isimli dosyada yer alan kodların isimleri ile aynı oluşturulmuş access dosyasındaki tablolardan ilgili aylara ait tutar toplamını aktarmasını istiyorum.

Örnek verecek olursam excel tablosunda yer alan "MSR_DIGR_CEGI" kodunda bulunan harcamalardan "STOKLAR_GT_2018.accdb" veritabanında aynı isimli masraf tablosunu bularak Ocak ayında yapılmış masrafların toplamını aktarılacak. ve bunu tüm tablolar için ilgili ayların toplamlarını alarak yapacak. Dosyanın tamamen çözülmesi önemli değil, mantığı anlatsanız yeter, gerisini ben halledebileceğime inanıyorum. Şimdiden zaman ayırdığınız için teşekkür ederim.

 

[Orion1]

Dosya ektedir.

Sub adoaktar59()
Dim conn As Object, rs As Object, i As Integer, ay As String
Dim sonsat As Long
Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Sheets("Sheet1").Select
Range("C2:C" & Rows.Count).ClearContents
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
If sonsat < 2 Then
    MsgBox "A sütununda masraf kodu yok!" & vbLf & "İşlem yapılmadı!", vbCritical, "UYARI"
    Exit Sub
End If
conn.Open ("Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\STOKLAR_GT_2018.accdb;")
For i = 2 To sonsat
    rs.Open "select sum(TUTAR) from[" & Cells(i, "A").Value & "] where AY='Ocak';", conn, 1, 1
    If rs.RecordCount > 0 Then Cells(i, "C").Value = rs.getrows
    rs.Close
Next i
conn.Close
Set rs = Nothing: Set conn = Nothing
MsgBox "İşlem Tamamdır." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[bluefalcon]

Evren Bey, siz nasıl bir kralsınız çok teşekkür ederim, elinize emeğinize sağlık

 

[Orion1]

Evren Bey, siz nasıl bir kralsınız çok teşekkür ederim, elinize emeğinize sağlık

Rica ederim.
İyi çalışmalar.