Kodlarımı iç içe geçirebilirmiyim ?

[cqners]

Merhabalar;

Problem aşağıdaki kodlardan 150 den fazla olması ve en ufak değişiklikte hepsini tek tek güncellemeye çalışmam örnek olarak verdiğim 3 kodu 1 kod haline getirebilirsem diğerlerini uyarlıyabilirim.
İginiz için Tşk.

Sub M06_08()
With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=Excel Dosyaları;DBQ=E:\Rapor\M06\08.xls;DefaultDir=E:\Rapor\M06;DriverId=790;MaxBufferSize=2048;PageTimeout=5;" _
, Destination:=Range("A1001"))
.CommandText = Array( _
"SELECT `AY$`.F1 AS 'YIL AY', `AY$`.F3 AS 'MAGAZA', `AY$`.F10 AS 'ENVANTER', `AY$`.F6 AS 'KATEGORI', Sum(`AY$`.`Net Adet`) AS 'NET ADET', Sum(`AY$`.`Vadeli Ciro`) AS 'NET CIRO', Count(`AY$`.F8) AS 'SKU" _
, _
"'" & Chr(13) & "" & Chr(10) & "FROM `E:\Rapor\M06\08`.`AY$` `AY$`" & Chr(13) & "" & Chr(10) & "GROUP BY `AY$`.F1, `AY$`.F3, `AY$`.F10, `AY$`.F6" _
)
.Name = "Excel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = False 'xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub

Sub M07_08()
With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=Excel Dosyaları;DBQ=E:\Rapor\M07\08.xls;DefaultDir=E:\Rapor\M07;DriverId=790;MaxBufferSize=2048;PageTimeout=5;" _
, Destination:=Range("A1201"))
.CommandText = Array( _
"SELECT `AY$`.F1 AS 'YIL AY', `AY$`.F3 AS 'MAGAZA', `AY$`.F10 AS 'ENVANTER', `AY$`.F6 AS 'KATEGORI', Sum(`AY$`.`Net Adet`) AS 'NET ADET', Sum(`AY$`.`Vadeli Ciro`) AS 'NET CIRO', Count(`AY$`.F8) AS 'SKU" _
, _
"'" & Chr(13) & "" & Chr(10) & "FROM `E:\Rapor\M07\08`.`AY$` `AY$`" & Chr(13) & "" & Chr(10) & "GROUP BY `AY$`.F1, `AY$`.F3, `AY$`.F10, `AY$`.F6" _
)
.Name = "Excel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = False 'xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub

Sub M08_08()
With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=Excel Dosyaları;DBQ=E:\Rapor\M08\08.xls;DefaultDir=E:\Rapor\M08;DriverId=790;MaxBufferSize=2048;PageTimeout=5;" _
, Destination:=Range("A1401"))
.CommandText = Array( _
"SELECT `AY$`.F1 AS 'YIL AY', `AY$`.F3 AS 'MAGAZA', `AY$`.F10 AS 'ENVANTER', `AY$`.F6 AS 'KATEGORI', Sum(`AY$`.`Net Adet`) AS 'NET ADET', Sum(`AY$`.`Vadeli Ciro`) AS 'NET CIRO', Count(`AY$`.F8) AS 'SKU" _
, _
"'" & Chr(13) & "" & Chr(10) & "FROM `E:\Rapor\M08\08`.`AY$` `AY$`" & Chr(13) & "" & Chr(10) & "GROUP BY `AY$`.F1, `AY$`.F3, `AY$`.F10, `AY$`.F6" _
)
.Name = "Excel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = False 'xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub

 

[ECYavuz]

Selamlar,

Sub M0_kodgelsin(M06)

Dim M06 as string

With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=Excel Dosyaları;DBQ=E:\Rapor\" & M06 & "\08.xls;DefaultDir=E:\Rapor\ " & M06 & ";DriverId=790;MaxBufferSize=2048;PageTimeou t=5;" _
, Destination:=Range("A1001"))
.CommandText = Array( _
"SELECT `AY$`.F1 AS 'YIL AY', `AY$`.F3 AS 'MAGAZA', `AY$`.F10 AS 'ENVANTER', `AY$`.F6 AS 'KATEGORI', Sum(`AY$`.`Net Adet`) AS 'NET ADET', Sum(`AY$`.`Vadeli Ciro`) AS 'NET CIRO', Count(`AY$`.F8) AS 'SKU" _
, _
"'" & Chr(13) & "" & Chr(10) & "FROM `E:\Rapor\ " & M06 & "\08`.`AY$` `AY$`" & Chr(13) & "" & Chr(10) & "GROUP BY `AY$`.F1, `AY$`.F3, `AY$`.F10, `AY$`.F6" _
)
.Name = "Excel"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = False 'xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub

şeklinde bir ana çağırma kod hazırlayıp, istediğiniz dönemi;

Call M0_kodgelsin(M06)
Call M0_kodgelsin(M07)
Call M0_kodgelsin(M08)

şeklinde çağırabilirisiniz. Yanıma Acsess olmadığı için deneyemedim ama benzer uygulamayı sorgu da bende yapıyorum...

 

[cqners]

Sn. ECYavuz

Öncelikle ilginiz için Teşekkürler.

Vermiş olduğunuz kodları deneyeceğim.
Veriler Oracle üzerinden Excel'e aktarılarak raporlama yapmaya çalışıyorum. Toplam 7 Bölge, Her bölgede 6 Büro, 12 ay, Her dosya 50 sayfa, Satır başına 19 hücre, 30000 satırdan oluşan Data, Toplam 14.364.000.000 Hücre den veri arıyorum. Ayrıntılara girdikçe ürkütücü rakamlar çıkmakta.
Excel, Makro sağolsun , Aslında bilgiyi paylaşmayı yardımlaşmayı seven sizler sağolun.