Bạn có thể chia sẻ sơ bộ cách xử lý là gì không?
Tôi thấy các file có cấu trúc giống nhau, nếu tên sheet của từng file giống nhau thì có thể dùng ADO kết hợp với mảng được.
※Bạn nên Copy Code về sớm, do Topic này tôi đã chủ động Report (Nhờ Addmin BQT delete)
Bạn tham khảo Code:
Sub Load_File_NhapLieu()
Dim Fso As Object, Item, dArr, i, k, CotMax, lR As Long
Dim WsM, Ws As Worksheet, Wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
CotMax = 21 'so cot lay gia tri
On Error Resume Next
Set WsM = Sheet1 'TH ActiveSheet
WsM.ShowAllData
Set Fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFilePicker) 'chon file
.AllowMultiSelect = True 'False
.Filters.Add "Microsoft Excel Files", "*.xlsx", 1 'file nhan dinh dang xlsx
If Not .Show = -1 Then 'neu khong chon file nao
MsgBox "Ban Can chon file De Tong Hop Ket Qua", vbInformation, "CONG TY TNHH ???" 'thi hien thong bao
Exit Sub
End If
''''Set DicR = CreateObject("Scripting.Dictionary")
ReDim dArr(1 To 10000, 1 To CotMax)
For Each Item In .SelectedItems
If Left(Item, 1) <> "~" Then
Set Wb = Workbooks.Open(Item)
'For Each Ws In Wb.Worksheets
Set Ws = Wb.Sheets(1)
'Ws.ShowAllData
k = k + 1
dArr(k, 1) = k
dArr(k, 2) = Ws.[G2].Value
dArr(k, 3) = Ws.[G4].Value
dArr(k, 4) = Ws.[G6].Value
dArr(k, 5) = Ws.[G8].Value
dArr(k, 6) = Ws.[V6].Value
dArr(k, 7) = Ws.[AP8].Value
dArr(k, 8) = Ws.[AF8].Value
dArr(k, 9) = Ws.[AY8].Value
dArr(k, 10) = Ws.[V4].Value
dArr(k, 11) = Ws.[V2].Value
dArr(k, 12) = Ws.[bj10].Value
dArr(k, 13) = Ws.[bk10].Value
dArr(k, 14) = Ws.[bl10].Value
dArr(k, 15) = Ws.[bm10].Value
dArr(k, 16) = Ws.[bn10].Value
dArr(k, 17) = Ws.[bo10].Value
dArr(k, 18) = Ws.[bp10].Value
dArr(k, 19) = Ws.[bq10].Value
dArr(k, 20) = Ws.[br10].Value
dArr(k, 21) = Ws.[bs10].Value
' dArr(k, 22) = Ws.[bt10].Value
' dArr(k, 23) = Ws.[bu10].Value
' dArr(k, 24) = Ws.[bV10].Value
' dArr(k, 25) = Ws.[bw10].Value
'dArr(k, 26) = Ws.[bx10].Value
' dArr(k, 27) = Ws.[by10].Value
' dArr(k, 28) = Ws.[bz10].Value
' dArr(k, 29) = Ws.[ca10].Value
'dArr(k, 30) = Ws.[cb10].Value
'dArr(k, 31) = Ws.[cc10].Value
'dArr(k, 32) = Ws.[cd10].Value
' dArr(k, 33) = Ws.[ce10].Value
' dArr(k, 34) = Ws.[cf10].Value
'dArr(k, 35) = Ws.[cg10].Value
'dArr(k, 36) = Ws.[ch10].Value
'khi muon them thong tin so cau tra loi thi them so cot tuong ung
End If
'Next
Wb.Close
Next
End With
lR = WsM.Range("B" & Rows.Count).End(3).Row 'tim dong cuoi
If lR > 2 Then 'neu dong cuoi lon hon 2
WsM.Range("B3:B" & lR).Resize(, CotMax).Delete 'thi xoa
'thay ClearContents va cCotmax tu so thanh bien
End If
If k Then
With WsM
.Range("B3").Resize(k, CotMax).Value = dArr 'gan gia tri vao dArr
End With
End If
End Sub
