RE: Birden Fazla Excel Sayfasını Tek Bir Excel Sayfasında Birleştirme - cdenktas - 10/12/2021
Söylemiş olduğunuzu denedim aynı hatayı verdi.
50 adet Excel dosyalarını tek bir Excel manuel alt alta koyduğumda 7562 satır veriyor. Satır sayının büyüklüğünden mi yoksa dosya sayının fazlalığından mı olabilir?
Uyarı mesajı ekte
RE: Birden Fazla Excel Sayfasını Tek Bir Excel Sayfasında Birleştirme - berduş - 10/12/2021
Kast ettiğim hata veren satır değil, hata verdiğinde acılan mesaj kutusunda yazan
Mesela bende çok karmaşık sorgu benzeri bir uyarı verdi
Sorun satır sayısı değil, sorgu kodu çok uzun ; 30 dosyadan sonra sorgu kodu accessin yorumlayamayacagi kadar uzun oluyor. Sorgu kodu oluşturmak yerine verile önce içe aktarılıp sadece son aşama sorguya alinir
Dediğim gibi sorgu çok uzun, uygun bir zamanda kodu değiştirip içe aktarmayla çözmeye çalışırız
RE: Birden Fazla Excel Sayfasını Tek Bir Excel Sayfasında Birleştirme - lemoncher2 - 10/12/2021
8. Mesajdaki örneğimi denediniz mi amaca hizmet edip etmediğini merak ediyorum
Re: Birden Fazla Excel Sayfasını Tek Bir Excel Sayfasında Birleştirme - berduş - 10/12/2021
kodlar yeniden düzenlenmiştir
modüldeki tüm kodları silip aşağıdaki kodları yapıştırarak dener misiniz?
bu arada @lemoncher2 hocamın da belirttiği gibi lütfen her önerimiz için bildirimde bulunun ki başka üyeler de faydalansınlar
1 - tüm dosyalar aynı klasörde olmalı
2 - referanslardan Microsoft ActiveX Data Object x.x library eklenmeli
3 - dosyanız macro çalıştıran formata çevrildi xlsm
4 - TmpSayfa adında bir sayfa eklendi veriler önce bu sayfaya ekleniyor toplamları alındıktan sonra sayfadaki veriler siliniyor
Option Compare Text
Sub VeriAl()
't1 = Timer
Application.ScreenUpdating = False
Dim Sql As String
Dim ADO_CN As ADODB.Connection
Set ADO_CN = New ADODB.Connection
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _
";extended properties=""excel 12.0 Xml;hdr=Yes"""
ADO_CN.Open
SQL = "SELECT [PLAKA], Count([PLAKA]), Sum([TOPLAM TUTAR]) " & _
"FROM [TmpSayfa$] " & _
"GROUP BY [PLAKA];"
Set SyfTmp = ThisWorkbook.Worksheets("TmpSayfa")
With SyfTmp
.Cells.Clear
.Cells(1, 1) = "PLAKA"
.Cells(1, 2) = "TOPLAM TUTAR"
End With
dosyaAdi_FSO ADO_CN
Set ADO_RS = ADO_CN.Execute(SQL)
' Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
GoTo son
End If
Set Syf = Sheets("Sayfa1")
Syf.Range("B2").CopyFromRecordset ADO_RS
SonStr = Syf.Cells(Syf.Rows.Count, "B").End(xlUp).Row - 1
With Syf.Range("a2")
.Value = 1
.AutoFill .Resize(SonStr, 1), xlFillSeries
End With
son:
SyfTmp.Cells.Clear
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
Application.ScreenUpdating = True
't2 = Timer
'Debug.Print "hy4_screen var", t2 - t1
MsgBox "Bitti"
End Sub
Sub dosyaAdi_FSO(con As ADODB.Connection)
Dim FSO As Object '//FileSystemObject
Dim f As Object '//File Object
AnaKlsr = ThisWorkbook.Path & "\"
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO
If .FolderExists(AnaKlsr) Then
For Each f In .GetFolder(AnaKlsr).Files
If f.Name <> ThisWorkbook.Name And Left(f.Name, 1) <> "~" And f.Type Like "*excel*" Then 'Debug.Print say, f.Name, SyfAdiAl(f.Path)
con.Execute SyfAdiAl(f.Path)
End If
Next f
End If
End With
End Sub
Function SyfAdiAl(fn As String) As String 'fn tam yol + ad
Dim conn As Object, db As Object
Dim tbl As Object
Set conn = CreateObject("DAO.DBEngine.120")
Set db = conn.OpenDatabase(fn, False, True, "Excel 12.0 Xml;HDR=Yes;")
Set tbl = db.TableDefs(0) ' 0 is Sheets(1) : 1 is Sheets(2)
SyfAdiAl = CStr(Replace(tbl.Name, "'", "")) ' sadece ilk sayfa tblAdi = CStr(Replace(tbl.Name, "'", ""))
SyfAdiAl = "INSERT INTO [Tmpsayfa$] ([Plaka], [TOPLAM TUTAR]) " & _
"SELECT [Plaka] ,[TOPLAM TUTAR] " & _
"FROM [" & SyfAdiAl & "] IN """ & fn & """ ""EXCEL 12.0 xml;"" "
Set db = Nothing
Set conn = Nothing
End Function
RE: Birden Fazla Excel Sayfasını Tek Bir Excel Sayfasında Birleştirme - berduş - 11/12/2021
aşağıdaki kod daha hızlı gibi
Option Compare Text
Sub VeriAl()
t1 = Timer
Application.ScreenUpdating = False
Dim Sql As String
Dim ADO_CN As ADODB.Connection
Set ADO_CN = New ADODB.Connection
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _
";extended properties=""excel 12.0 Xml;hdr=Yes"""
ADO_CN.Open
SQL = "SELECT [PLAKA], Count([PLAKA]), Sum([TOPLAM TUTAR]) " & _
"FROM [TmpSayfa$] " & _
"GROUP BY [PLAKA];"
Set SyfTmp = ThisWorkbook.Worksheets("TmpSayfa")
With SyfTmp
.Cells.Clear
.Cells(1, 1) = "PLAKA"
.Cells(1, 2) = "TOPLAM TUTAR"
End With
dosyaAdi_FSO2 ADO_CN
Set ADO_RS = ADO_CN.Execute(SQL)
' Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
GoTo son
End If
Set Syf = Sheets("Sayfa1")
Syf.Range("B2").CopyFromRecordset ADO_RS
SonStr = Syf.Cells(Syf.Rows.Count, "B").End(xlUp).Row - 1
With Syf.Range("a2")
.Value = 1
.AutoFill .Resize(SonStr, 1), xlFillSeries
End With
son:
SyfTmp.Cells.Clear
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
Application.ScreenUpdating = True
t2 = Timer
Debug.Print "hy4_son hali", t2 - t1
'MsgBox "Bitti"
End Sub
Sub dosyaAdi_FSO2(con As ADODB.Connection)
Dim FSO As Object '//FileSystemObject
Dim f As Object '//File Object
AnaKlsr = ThisWorkbook.Path & "\"
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO
If .FolderExists(AnaKlsr) Then
Dim conn2 As Object
Set conn2 = CreateObject("DAO.DBEngine.120")
For Each f In .GetFolder(AnaKlsr).Files
If f.Name <> ThisWorkbook.Name And Left(f.Name, 1) <> "~" And f.Type Like "*excel*" Then 'Debug.Print say, f.Name, SyfAdiAl(f.Path)
con.Execute SyfAdiAl2(f.Path, conn2)
End If
Next f
Set conn2 = Nothing
End If
End With
End Sub
Function SyfAdiAl2(fn As String, conn As Object) As String 'fn tam yol + ad
Dim db As Object
Dim tbl As Object
Set db = conn.OpenDatabase(fn, False, True, "Excel 12.0 Xml;HDR=Yes;")
Set tbl = db.TableDefs(0) ' 0 is Sheets(1) : 1 is Sheets(2)
SyfAdiAl2 = CStr(Replace(tbl.Name, "'", "")) ' sadece ilk sayfa tblAdi = CStr(Replace(tbl.Name, "'", ""))
SyfAdiAl2 = "INSERT INTO [Tmpsayfa$] ([Plaka], [TOPLAM TUTAR]) " & _
"SELECT [Plaka] ,[TOPLAM TUTAR] " & _
"FROM [" & SyfAdiAl2 & "] IN """ & fn & """ ""EXCEL 12.0 xml;"" "
Set db = Nothing
End Function
RE: Birden Fazla Excel Sayfasını Tek Bir Excel Sayfasında Birleştirme - cdenktas - 21/12/2021
Kolay Gelsin;
Rahatsızlığım sebebiyle bugün siteye girebildim, göstermiş olduğunuz ilgiden dolayı teşekkür ederim..
Ancak dediğiniz gibi hem eski Excel kod yapıştırdım hem de sizin Excel uzantılı macro indirdim ve çalıştırdığımda hata veriyor...
con.Execute SyfAdiAl(f.Path) kısmında hata veriyor...(Sarı Renk)
Resmi eklemek istedim ancak ekle kısmı açılmadı....
|