Xin giúp về code VBA tổng hợp dữ liệu bổ nhiệm giáo viên

[congatrong82]

Minh có 10 file cần tổng hợp qua File Tong Hop Bo nhiem Tieu Hoc 2015
Mình nhờ ACE diễn đàn viết dùm code tổng hợp file. Xin chân thành cảm ơn ACE diễn đàn rất nhiều.
Do hết quota nên mình gởi link dưới.
Link: https://drive.google.com/file/d/0B6c...ew?usp=sharing

 

[seikoqn]

Minh có 10 file cần tổng hợp qua File Tong Hop Bo nhiem Tieu Hoc 2015
Mình nhờ ACE diễn đàn viết dùm code tổng hợp file. Xin chân thành cảm ơn ACE diễn đàn rất nhiều.
Do hết quota nên mình gởi link dưới.
Link: https://drive.google.com/file/d/0B6c...ew?usp=sharing

Cả 10 File đều giống nhau mà bạn? Nếu vậy bạn chỉ cần copy pase từ 1 File bất kỳ sang File TH là xong!

 

[doveandrose]

xem hướng dẫn ở đây
http://www.giaiphapexcel.com/forum/...viết-code-tổng-hợp-dữ-liệu-bổ-nhiệm-giáo-viên

 

[congatrong82]

Do co nhiều file, khoan 80file, neu coppy thi qua lau ban ak. Nên mình nhờ viết code thoi

 

[congatrong82]

Cả 10 File đều giống nhau mà bạn? Nếu vậy bạn chỉ cần copy pase từ 1 File bất kỳ sang File TH là xong!

Ý của mình thì khác. Hiện tại mình có khoản 86 trường. Bởi vậy mới nhờ viết code vba bạn à.

 

[hpkhuong]

Minh có 10 file cần tổng hợp qua File Tong Hop Bo nhiem Tieu Hoc 2015
Mình nhờ ACE diễn đàn viết dùm code tổng hợp file. Xin chân thành cảm ơn ACE diễn đàn rất nhiều.
Do hết quota nên mình gởi link dưới.
Link: https://drive.google.com/file/d/0B6c...ew?usp=sharing

Paste code vào module file tổng. Chạy code -> cửa sổ mở ra -> Chọn nguyên folder chứa file con -> Ngồi đợi -> Xong

Option Explicit
Sub GPE()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ChonO As Object, ChonF As Object, pFile, Path, lr&, lr2&
Dim fil As Object, Data, Wb As Workbook, Sh As Worksheet, WsMain As Worksheet
pFile = ActiveWorkbook.Name
Set WsMain = ActiveWorkbook.Sheets("Tonghop")
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "CHON FOLDER"
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    Path = .SelectedItems(1) & "\"
End With
WsMain.Range("A11:T65000").ClearContents
Set ChonO = CreateObject("scripting.filesystemobject")
Set ChonF = ChonO.GetFolder(Path)
For Each fil In ChonF.Files
    If InStr(1, fil.Name, pFile) <= 0 Then
        Set Wb = Workbooks.Open(fil.Path)
        Set Sh = Wb.ActiveSheet
        lr2 = Sh.Range("A65000").End(3).Row - 1
        Data = Sh.Range("A10:T" & lr2)
        Workbooks(fil.Name).Close
        lr = [A65000].End(3).Row
        WsMain.Range("A" & lr).Offset(1).Resize(UBound(Data), UBound(Data, 2)) = Data
    End If
Next fil
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Hoặc có thể xài ADO cho tốc độc cực nhanh (Cí này học từ bạn "Chim Hồng")

Copy code. Paste vào Module file tổng hợp. Chạy code. Ra cửa sổ -> Chọn tới foder chứa file con -> Open folder này Select hết các file muốn tổng hợp -> Ok -> Xong.

Public Sub TongHop()
Dim CoN As Object, Data As Object, I As Byte, mR As Long
Set CoN = CreateObject("adodb.connection")
    'Provider=Microsoft.ACE.OLEDB.12.0 '(office 64Bit)
    'microsoft.jet.oledb.4.0 '(office 32Bit)
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = ThisWorkbook.Path
        .Filters.Clear
        .Filters.Add "Chon File", "*.xls*"
        .AllowMultiSelect = True
        .Show
    For I = 1 To .SelectedItems.Count
        CoN.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & _
        .SelectedItems(I) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
        
        Set Data = CoN.Execute("select * from [Sheet1 (2)$A10:T] where f1 is not null")
        mR = WorksheetFunction.Max(Sheet1.[A65000].End(xlUp).Row + 1, 11)
            If Not Data.EOF Then Worksheets("Tonghop").Range("A" & mR).CopyFromRecordset Data
        Data.Close
        CoN.Close
    Next I
    End With
End Sub

 

[chuot0106]

Minh có 10 file cần tổng hợp qua File Tong Hop Bo nhiem Tieu Hoc 2015
Mình nhờ ACE diễn đàn viết dùm code tổng hợp file. Xin chân thành cảm ơn ACE diễn đàn rất nhiều.
Do hết quota nên mình gởi link dưới.
Link: https://drive.google.com/file/d/0B6c...ew?usp=sharing

Đặt File này và các File cấn tổng hợp vào cùng 1 thư mục giống lúc bạn đưa nên! Chạy code và xem kết quả!

 

[namkpac]

Đặt File này và các File cấn tổng hợp vào cùng 1 thư mục giống lúc bạn đưa nên! Chạy code và xem kết quả!

Public Sub TongHop()
Dim CoN As Object, Data As Object, I As Byte, mR As Long
Set CoN = CreateObject("adodb.connection")
'Provider=Microsoft.ACE.OLEDB.12.0 '(office 64Bit)
'microsoft.jet.oledb.4.0 '(office 32Bit)
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = ThisWorkbook.Path
.Filters.Clear
.Filters.Add "Chon File", "*.xls*"
.AllowMultiSelect = True
.Show
For I = 1 To .SelectedItems.Count
CoN.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & _
.SelectedItems(I) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")

Set Data = CoN.Execute("select * from [Sheet1 (2)$A10:T] where f1 is not null")
mR = WorksheetFunction.Max(Sheet1.[A65000].End(xlUp).Row + 1, 11)
'If Not Data.EOF Then Worksheets("Tonghop").Range("A" & mR).CopyFromRecordset Data
Data.Close
CoN.Close
Next I

Worksheets("Tonghop").Range("A" & mR).Consolidate Sources:=Data, Function:=xlSum
End With
End Sub

Em muốn dùng consoildate mà duyệt qua từng mảng thế này nó báo lỗi consolidated method of range class failed là sao anh (chị) nhỉ?. giả sử số liệu trong file chỉ là định dạng số. thì dùng consolidate sum là để cộng dồn số thì nó không duyệt qua từng mảng để cộng dồn. anh (chị) chỉ giúp em với.