Nhờ anh chị giúp gộp nhiều file ADO

[Trần Văn Bình]

Mình có nhiều file dữ liệu nay muốn gộp các file vào 1 file đồng thời xử lý dữ liệu dạng số ví dụ cột dữ liệu nguồn có 3.25 thành 3,25
mình sưu tầm Code có sửa lại mà bị lỗi có file đính kèm
Rất mong các bạn giúp

 

[Trần Văn Bình]

Code của mình sưu tầm của @befaint mình sữa lại 1 ít cho phù hợp cấu trúc dữ liệu

code VBA lấy dữ liệu từ nhiều file vào 1 file

Xin nhờ các anh chị trên diễn dàn giúp em, Mỗi tuần lễ, trên văn phòng chính sẽ xuất 1 file báo cáo xuống (mỗi file khoảng 7.000 dòng), cuối tháng em phải lấy nội dung của từng file ( chỉ lấy 9 cột trong mỗi file : cột K , cột R đến cột Y) rồi dán hết vào file tổng hợp . Kết quả cuối cùng là...

www.giaiphapexcel.com

 

[giaiphap]

Mình có nhiều file dữ liệu nay muốn gộp các file vào 1 file đồng thời xử lý dữ liệu dạng số ví dụ cột dữ liệu nguồn có 3.25 thành 3,25
mình sưu tầm Code có sửa lại mà bị lỗi có file đính kèm
Rất mong các bạn giúp

Thử sửa thế này xem có được không?

Sub GetData()
    Dim Dc As Long, J As Long
    Dim Ma_hoc_vien As String
    Dim Arr(), sql As String
    With Sheet2
    Dc = .Range("C1000").End(xlUp).Row
    Arr = .Range("C7:D" & Dc)
    For J = 1 To UBound(Arr)
        Ma_hoc_vien = Ma_hoc_vien & ",'" & Arr(J, 1) & "'"
    Next
        Ma_hoc_vien = Mid(Ma_hoc_vien, 2)
    
    End With

    sql = "SELECT f1, REPLACE(f2,'.',','), f3, f4, f4, REPLACE(f6,'.',','), f7, f8, f9, f10, f11, f12, f13, f14 FROM [Sheet1$B2:O65000] where f7 IN (" & Ma_hoc_vien & ")"
    
    Dim cn As Object, rs As Object, list_path As Variant, ex_path As Variant
    Dim lR As Long
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    list_path = SelectExcelFiles(, True)
    If IsArray(list_path) = False Then Exit Sub
    
    Sheet1.Range("B6:P1048500").ClearContents
    
    For Each ex_path In list_path
    
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ex_path & _
            ";Extended Properties=""Excel 12.0;HDR=No;"""

        With Sheet1
            lR = .Range("C" & .Rows.Count).End(xlUp).Row + 1
            Set rs = cn.Execute(sql)
            If Not rs.EOF Then .Range("B" & lR).CopyFromRecordset rs
        End With
        
        rs.Close
        cn.Close
    Next ex_path
    Set cn = Nothing: Set rs = Nothing
    Set list_path = Nothing
End Sub

 

[Trần Văn Bình]

Thử sửa thế này xem có được không?

Sub GetData()
    Dim Dc As Long, J As Long
    Dim Ma_hoc_vien As String
    Dim Arr(), sql As String
    With Sheet2
    Dc = .Range("C1000").End(xlUp).Row
    Arr = .Range("C7:D" & Dc)
    For J = 1 To UBound(Arr)
        Ma_hoc_vien = Ma_hoc_vien & ",'" & Arr(J, 1) & "'"
    Next
        Ma_hoc_vien = Mid(Ma_hoc_vien, 2)
   
    End With

    sql = "SELECT f1, REPLACE(f2,'.',','), f3, f4, f4, REPLACE(f6,'.',','), f7, f8, f9, f10, f11, f12, f13, f14 FROM [Sheet1$B2:O65000] where f7 IN (" & Ma_hoc_vien & ")"
   
    Dim cn As Object, rs As Object, list_path As Variant, ex_path As Variant
    Dim lR As Long
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
   
    list_path = SelectExcelFiles(, True)
    If IsArray(list_path) = False Then Exit Sub
   
    Sheet1.Range("B6:P1048500").ClearContents
   
    For Each ex_path In list_path
   
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ex_path & _
            ";Extended Properties=""Excel 12.0;HDR=No;"""

        With Sheet1
            lR = .Range("C" & .Rows.Count).End(xlUp).Row + 1
            Set rs = cn.Execute(sql)
            If Not rs.EOF Then .Range("B" & lR).CopyFromRecordset rs
        End With
       
        rs.Close
        cn.Close
    Next ex_path
    Set cn = Nothing: Set rs = Nothing
    Set list_path = Nothing
End Sub

Cám ơn bạn rất nhiều đầy le code mình đúng nguyện vọng của mình rồi
.lần nữa chân thần cám ơn