- Katılım
- 2 Mart 2005
- Mesajlar
- 2,960
- Excel Vers. ve Dili
-
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Sub TabloMYIL()
'//////////////Anemos\\\\\\\\\\\\\\\\\
UserForm1.Show False: DoEvents 'Userformu gösterdikten sonra kodları işlemeye devam et
Dim wsOZET As Worksheet: Set wsOZET = Sheets("TABLOM")
Dim cn As Object: Set cn = CreateObject("ADODB.Connection")
Dim rs As Object
wsOZET.Range("A2:F200").ClearContents
cn.Open "Driver={Microsoft Excel Driver (*.xls)};dbq=" & ThisWorkbook.FullName
srgYil = 2007
sorgu = "mYIL = " & srgYil
strTip = "Tip1"
Set rs = cn.Execute( _
"SELECT DISTINCT BYIL, MYIL, GIDER_TURU, MES_MER, Sum(TUTAR) AS TOP_TUTAR" & _
" FROM[2007$F4:J65536]" & _
" WHERE " & sorgu & _
" GROUP BY BYIL, MYIL, GIDER_TURU, MES_MER")
wsOZET.Cells(2, 1).CopyFromRecordset rs
rs.Close
Set rs = Nothing
'Call Kodlar_Ic
'========================================
sonsat = wsOZET.Range("A65536").End(3).Row + 1
sorgu = "BYIL = " & srgYil & _
" AND MYIL <> " & srgYil
strTip = "Tip2"
Set rs = cn.Execute( _
"SELECT DISTINCT BYIL, MYIL, GIDER_TURU, MES_MER, Sum(TUTAR) AS TOP_TUTAR" & _
" FROM[2007$F4:J65536]" & _
" WHERE " & sorgu & _
" GROUP BY BYIL, MYIL, GIDER_TURU, MES_MER")
wsOZET.Cells(sonsat, 1).CopyFromRecordset rs
rs.Close: Set rs = Nothing
Set rs = Nothing
'========================================
cn.Close: Unload UserForm1
MsgBox "tamamlandı2"
End Sub
Set rs = cn.Execute( _
"SELECT DISTINCT BYIL, MYIL, GIDER_TURU, MES_MER, Sum(TUTAR)
2007 2007 Muh Genel 20.600,00 Tip1
yazan başlıkların içine döngüde atadaığımız Tip1 de recordsetle Tutarın yanında yapıştırsın.
2. bölümdede
2007 2008 Sanayii Genel 5.250,00 Tip2
gibi bu mümkünmüdür hocam Ana tabloda bunu ayırmak oldukça güç olur ve Srgyılına göre tip1 ve tip2 durumu değişir.