Giúp em tối ưu code cập nhật dữ liệu từ file khác

[at7707]

Em đang nghiên cứu code Update dữ liệu từ các file khác nhau. Nếu số lượng dữ liệu lên nhiều (khoảng 1000) là nó chạy lâu quá

Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim n As Long, rNum As Long
Dim i As Long, j As Long
Dim SourceEndRow As Long
Dim DestEndRow As Long
 
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant
 
SaveDriveDir = CurDir
On Error Resume Next
MyPath = "C:\"
ChDrive MyPath
ChDir MyPath
 
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
If IsArray(FName) Then
    Application.ScreenUpdating = False
    
    Set basebook = ActiveWorkbook
    rNum = 1
            
    For n = LBound(FName) To UBound(FName)
        Set mybook = Workbooks.Open(FName(n))
        
        'Xac dinh dong cuoi cung cua du lieu can copy va dich copy den
        SourceEndRow = mybook.Sheets(1).Range("A60000").End(xlUp).Row
        DestEndRow = basebook.Sheets(1).Range("A60000").End(xlUp).Row
        
        For i = 2 To SourceEndRow
            For j = 2 To DestEndRow
                If mybook.Sheets(1).Range("A" & i).Value = basebook.Sheets(1).Range("A" & j).Value Then
                    basebook.Sheets(1).Range("B" & j).Value = mybook.Sheets(1).Range("B" & i).Value
                    basebook.Sheets(1).Range("C" & j).Value = mybook.Sheets(1).Range("C" & i).Value
                End If
            Next j
        Next i
        
        
        'Dong file
        mybook.Close False
        
    Next n
End If
'Tra ve mac dinh truoc khi mo
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

(Em không up dược file nên up code)
Các bác có cao kiến gì thì giúp em với ạ!

Các cao thủ giúp em vụ này với ạ.
Many thanks!

 

[ptlong04x1]

Vì không có file nên khó hình dung được vị trí dữ liệu. Bạn nén file lại rồi gửi lên và ghi rõ yêu cầu muốn cập nhật dữ liệu như thế nào, có thể sẽ có code khác ngắn hơn.

 

[at7707]

Em up file ạ. Các bác giúp em với!

 

[ptlong04x1]

Em up file ạ. Các bác giúp em với!

Code của mình như sau, với code này, bạn chỉ cần chọn thư mục chứa các file Data.xls nó sẽ tự tìm ra các file và tổng hợp dữ liệu chứ không cần chọn từng file như bạn làm.

Sub GetData(FolPath As String)
    Dim Fil As Scripting.File, Fol As Scripting.Folder
    With New Scripting.FileSystemObject
        For Each Fil In .GetFolder(FolPath).Files
            If InStr(Fil.Name, ".xls") And Fil.Name <> ThisWorkbook.Name Then
                With Application.Workbooks.Open(Fil.Path)
                    .Sheets(1).Range("a2", Sheets(1).[c65000].End(xlUp)).Copy _
                    ThisWorkbook.ActiveSheet.[a65000].End(xlUp)(2)
                    .Close (False)
                End With
            End If
        Next Fil
        For Each Fol In .GetFolder(FolPath).SubFolders
            Call GetData(Fol.Path)
        Next Fol
    End With
End Sub

Sub RunGetData()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        .AllowMultiSelect = False
        Call GetData(.SelectedItems(1))
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

[at7707]

Cảm ơn bác ptlong04x1! Vấn đề của em là không phải em copy toàn bộ dữ liệu vào file Tổng mà trong file Tổng cột A đã có sẵn WorkCode, ứng với mỗi WorkCode bên các file data em phải tìm WorkCode tương ứng bên file Tổng để update dữ liệu vào.
Với file em đã up lên thì nó chạy chậm quá, với khoảng 4000 dữ liệu thì nó phải mất khoảng 10 phút :-(
Các bác có cao kiến gì thì giúp em với nhé!

 

[ptlong04x1]

Như vậy cột WorkCode trong file tổng có phải là toàn bộ WorkCode của các file data không, nếu đúng như vậy bạn cho mình biết là kết quả của việc copy toàn bộ dữ liệu sang file tổng và việc chỉ update ở cột b, c của file tổng có gì khác nhau???

 

[at7707]

Cảm ơn bác!
WorkCode trong file tổng có thể không phải là toàn bộ WorkCode trong các file data.
Bài toán còn có các yêu cầu sau:
- Trong file tổng có thêm nhiều thông tin khác ngoài côt B,C nữa nên chỉ update cột B,C thôi.
- File tổng có thể sắp xếp không theo thứ tự giống như file Data.

 

[at7707]

Bác ptlong04x1 giúp đỡ em tiếp vấn đề này với ạ.
Thanks bác nhiều!