Skip to main content

AccessTr.neT


Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme

Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme

Çözüldü #1
Klasör içerisindeki Excel dosyalarını tek dosyada birleştirmek istiyorum. ADO yöntemi kullanılan dosyaları indirip uyarlamaya çalıştım ama bir türlü birleştiremedim. ADO yöntemi ile kapalı dosyalardan verileri tek dosyaya toplayabilir miyiz?

Kriterler

1 - BİRİM (1).............BİRİM (50) ye kadar 50 adet bir klasör içerisinde dosyam var.

2 - Kapalı olan BİRİM (1)........BİRİM (50) ye kadar xlsm dosyalarından 00 - Tüm Veri Dosyası"na verileri çekmek istiyorum.

3 - Dosya içerisindeki formatlar aynıdır. Sütunlar sabit olup satırlara girilen veriler değişebiliyor. 5 satır 16 satır gibi. Kimi birimde ise 50 satır olabiliyor.

4 - Dosya içerisinde kişisel bilgi yoktur, deneme verileri oluşturulmuştur.

Yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.
.rar Verileri Birleştir.rar (Dosya Boyutu: 939,07 KB | İndirme Sayısı: 2)
yyhy, 18-05-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla
#2
Dosyayı deneyemedim lakin union all ile oluyor heralde sorgu olarak.
Cevapla
#3
Videoyu anlatan adam acayip bişey tavsiye ederim tüm videolarını izlemenizi ingilizce bilmeseniz bile anlıyor insan.Sanırın videodaki gbi istiyorsunuz abey.
Cevapla
#4
Sayın feraz bey web ten benim konu ile ilgili örnek dosyaları inceledim videolara bakmadım. ADO yöntemi kullanılmış.
Dosyalar indirdiğim şekli ile çalışıyorlar benim eklemiş olduğum dosyalara uyarlayamadım. Acaba ne yapabiliriz?
yyhy, 18-05-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla
#5
Abey dosyada kod yok ayrıca videoyu izleyip uygulamanızı önermiştim bende uyguladım ufak tefek değişiklik yaparak.
Alttaki kodu deneyin.
Hata olursa koddaki Türkçe karakterleri düzeltin.

Visual Basic Code
Sub test()
    Dim rs As Object, con As Object, sql As String
    
    Set rs = CreateObject("ADODB.Recordset")
    Set con = CreateObject("ADODB.Connection")
    Dim yol As String, yol2 As String
    
    yol = ThisWorkbook.Path & Application.PathSeparator
    yol2 = Dir(yol & "*xlsx")

    With ThisWorkbook.Sheets("TümVeri")
        .Range("A2:Q" & Rows.Count).Clear
        Do Until yol2 = ""
            If Not yol2 Like "00 -Tüm Veri*" Then
                con.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & yol2 & ";extended properties=""Excel 12.0;hdr=yes"""
                sql = sql & " union all select * from [MEMURLAR$]"
                sql = Mid(sql, 12)
                rs.Open sql, con, 1, 1
                .Range("A" & Rows.Count).End(3)(2, 1).CopyFromRecordset rs
                sql = ""
                rs.Close
                con.Close
            End If
            yol2 = Dir
        Loop
    End With
    Set rs = Nothing
    Set con = Nothing
End Sub
Cevapla
#6
Dosyayıda ekleyeyim bari Img-grin

Eğer verilerin geleceği Excel Formatı xlsx değilse  If Not yol2 Like "00 -Tüm Veri*" Thenve End if kısmını silebilirsiniz.Bende bu dosyada pasif yaptım.
A sütunudaki gereksiz satırları silinki doğru çalışsın alt alta.

Visual Basic Code
Private Sub CommandButton1_Click()
    Dim rs As Object, con As Object, sql As String
    
    Set rs = CreateObject("ADODB.Recordset")
    Set con = CreateObject("ADODB.Connection")
    Dim yol As String, yol2 As String
    
    yol = ThisWorkbook.Path & Application.PathSeparator
    yol2 = Dir(yol & "*xlsx")

    With ThisWorkbook.Sheets("TümVeri")
        .Range("A2:Q" & Rows.Count).Clear
        Do Until yol2 = ""
'            If Not yol2 Like "00 -Tüm Veri*" Then
                con.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & yol2 & ";extended properties=""Excel 12.0;hdr=yes"""
                sql = sql & " union all select * from [MEMURLAR$]"
                sql = Mid(sql, 12)
                rs.Open sql, con, 1, 1
                .Range("A" & Rows.Count).End(3)(2, 1).CopyFromRecordset rs
                sql = ""
                rs.Close
                con.Close
'            End If
            yol2 = Dir
        Loop
    End With
    Set rs = Nothing
    Set con = Nothing
    MsgBox "Bitti", vbInformation, "Bilgi"
End Sub
.rar Verileri Birleştir.rar (Dosya Boyutu: 940,16 KB | İndirme Sayısı: 9)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da