Özet Tablo Hk.

[Erdogan3434]

Merhaba Hocalarım,
Ekte bulunan örnek rapora ekleme yapmak istediğim iki husus var. Destek vermenizi rica ediyorum.

• Öncelikle tablo Selection_Change ile çalışıyor ama normal Sub ile çalışacak şekilde değiştirebilir miyiz?
• Ayrıca tabloya elle eklediğim P:S sütunları arasında ki özet tablomu da kodun içinde gelecek şekilde ekleyebilir miyiz?

Desteğiniz ricasıyla.

Saygılarımla.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Rapor()
    Dim My_File As String, Process_Time As Double
    Dim My_Connection As Object, My_Recordset As Object
    Dim My_Date_1 As Date, My_Date_2 As Date
    
    Process_Time = Timer
    
    Application.ScreenUpdating = False
    
    Range("J7:N" & Rows.Count).Clear
    Range("P2:S" & Rows.Count).Clear
    
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")
    
    My_File = ThisWorkbook.FullName
    My_Date_1 = Range("J2").Value
    My_Date_2 = Range("K2").Value
    
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    My_File & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
    
    Set My_Recordset = My_Connection.Execute("Select TARİH,BÖLÜM,SUM([PER#]),SUM([YÖN# ]),SUM([TOP#]) From [Sayfa1$] Where TARİH Between " & _
                                              CLng(CDate(My_Date_1)) & " And " & CLng(CDate(My_Date_2)) & " Group By TARİH,BÖLÜM")
           
    Range("J7").CopyFromRecordset My_Recordset
    Range("J7").CurrentRegion.Borders.LineStyle = 1

    Set My_Recordset = My_Connection.Execute("Select BÖLÜM,SUM([PER#]),SUM([YÖN# ]),SUM([TOP#]) From [Sayfa1$] Where TARİH Between " & _
                                              CLng(CDate(My_Date_1)) & " And " & CLng(CDate(My_Date_2)) & " Group By BÖLÜM Union All " & _
                                             "Select 'Genel Toplam',SUM([PER#]),SUM([YÖN# ]),SUM([TOP#]) From [Sayfa1$] Where TARİH Between " & CLng(CDate(My_Date_1)) & " And " & CLng(CDate(My_Date_2)))
    Range("P2").CopyFromRecordset My_Recordset
    Range("P2").CurrentRegion.Borders.LineStyle = 1
    
    If My_Recordset.State <> 0 Then My_Recordset.Close
    If My_Connection.State <> 0 Then My_Connection.Close
    
    Set My_Connection = Nothing
    Set My_Recordset = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye"
End Sub

 

[Erdogan3434]

Deneyiniz.

Option Explicit

Sub Rapor()
    Dim My_File As String, Process_Time As Double
    Dim My_Connection As Object, My_Recordset As Object
    Dim My_Date_1 As Date, My_Date_2 As Date
   
    Process_Time = Timer
   
    Application.ScreenUpdating = False
   
    Range("J7:N" & Rows.Count).Clear
    Range("P2:S" & Rows.Count).Clear
   
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")
   
    My_File = ThisWorkbook.FullName
    My_Date_1 = Range("J2").Value
    My_Date_2 = Range("K2").Value
   
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    My_File & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
   
    Set My_Recordset = My_Connection.Execute("Select TARİH,BÖLÜM,SUM([PER#]),SUM([YÖN# ]),SUM([TOP#]) From [Sayfa1$] Where TARİH Between " & _
                                              CLng(CDate(My_Date_1)) & " And " & CLng(CDate(My_Date_2)) & " Group By TARİH,BÖLÜM")
          
    Range("J7").CopyFromRecordset My_Recordset
    Range("J7").CurrentRegion.Borders.LineStyle = 1

    Set My_Recordset = My_Connection.Execute("Select BÖLÜM,SUM([PER#]),SUM([YÖN# ]),SUM([TOP#]) From [Sayfa1$] Where TARİH Between " & _
                                              CLng(CDate(My_Date_1)) & " And " & CLng(CDate(My_Date_2)) & " Group By BÖLÜM Union All " & _
                                             "Select 'Genel Toplam',SUM([PER#]),SUM([YÖN# ]),SUM([TOP#]) From [Sayfa1$] Where TARİH Between " & CLng(CDate(My_Date_1)) & " And " & CLng(CDate(My_Date_2)))
    Range("P2").CopyFromRecordset My_Recordset
    Range("P2").CurrentRegion.Borders.LineStyle = 1
   
    If My_Recordset.State <> 0 Then My_Recordset.Close
    If My_Connection.State <> 0 Then My_Connection.Close
   
    Set My_Connection = Nothing
    Set My_Recordset = Nothing
   
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye"
End Sub

Korhan Hocam,
Her zaman olduğu gibi muhteşem olmuş. Emeğinize sağlık.
Saygılarımla.