Chào mọi người
Mình có file excel trong đó có viết đoạn code để tổng hợp dữ liệu từ nhiều file khác nhau một cách tự động (học của tác giả Đức Thanh trên Youtube).
Nhưng file chỉ chạy lần đầu tiên, các lần sau chỉ chạy được nửa chừng, tức là chỉ mở được file dữ liệu đầu tiên và để đó, không chạy nữa. Nhờ mọi người hướng dẫn xem vấn đề ở chỗ nào để mình khắc phục.
(File chính: Consolidate du lieu tu nhieu file.xls
File dữ liệu: Source 1, Source 2, Source 3.xls)
Chào mọi người
Mình có file excel trong đó có viết đoạn code để tổng hợp dữ liệu từ nhiều file khác nhau một cách tự động (học của tác giả Đức Thanh trên Youtube).
Nhưng file chỉ chạy lần đầu tiên, các lần sau chỉ chạy được nửa chừng, tức là chỉ mở được file dữ liệu đầu tiên và để đó, không chạy nữa. Nhờ mọi người hướng dẫn xem vấn đề ở chỗ nào để mình khắc phục.
(File chính: Consolidate du lieu tu nhieu file.xls
File dữ liệu: Source 1, Source 2, Source 3.xls)
Cảm ơn bạn PacificPR, mình đã thử và đã thực hiện được với file có số dòng ít (khoảng 20 dòng), tuy nhiên với file có số lượng dòng lớn cỡ 40k dòng thì câu lệnh đó không chạy (chưa hiểu được vì sao), mình đành phải cho i chạy từ 1 đến 65k để dò tìm.
Cảm ơn bạn PacificPR, mình đã thử và đã thực hiện được với file có số dòng ít (khoảng 20 dòng), tuy nhiên với file có số lượng dòng lớn cỡ 40k dòng thì câu lệnh đó không chạy (chưa hiểu được vì sao), mình đành phải cho i chạy từ 1 đến 65k để dò tìm.
Cảm ơn bạn PacificPR, mình đã thử và đã thực hiện được với file có số dòng ít (khoảng 20 dòng), tuy nhiên với file có số lượng dòng lớn cỡ 40k dòng thì câu lệnh đó không chạy (chưa hiểu được vì sao), mình đành phải cho i chạy từ 1 đến 65k để dò tìm.
File của bạn (không biết có phải code gốc hay không?) nhưng có vài lỗi nghiêm trọng và căn bản trong lập trình VBA mà cần phải hiểu bản chất và khắc phục
Code hiện nay của bạn là:
Mã:
Sub import_data()
Dim maSter As Worksheet, sh As Worksheet
Dim wk As Workbook
Dim strFolderPath As String
Dim selectedFiles As Variant
Dim iFileNum As Integer
Dim strFileName As String
Dim iLastRowReport As Integer, iNumberOfRowToPaste As Integer
Dim rID As Range, rQuantity As Range, rUnitPrice As Range, rKM As Range, rMC As Range
Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
Dim startTime As Double
getSpeed (True)
Set maSter = ActiveWorkbook.Sheets("Sheet1")
strFolderPath = ActiveWorkbook.Path
ChDrive strFolderPath
ChDir strFolderPath
selectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
startTime = Timer
On Error GoTo thoat
For iFileNum = LBound(selectedFiles) To UBound(selectedFiles)
strFileName = selectedFiles(iFileNum)
Set wk = Workbooks.Open(strFileName)
For Each sh In wk.Sheets
If sh.Name Like "To trinh boi thuong" Then
With sh
iLastRowReport = .Range("A" & Rows.Count).End(xlUp).Row
MsgBox ("so dong nguon " & iLastRowReport)
iNumberOfRowToPaste = iLastRowReport - 6 + 1
Set rID = .Range("A6:A" & iLastRowReport)
'Set rQuantity = .Range("C6:C" & iLastRowReport)
'Set rUnitPrice = .Range("E6:E" & iLastRowReport)
'Set rKM = .Range("G6:G" & iLastRowReport)
'Set rMC = .Range("J6:J" & iLastRowReport)
With maSter
iCurrentLastRow = .Range("A" & Rows.Count).End(xlUp).Row
MsgBox ("so dong dich " & iCurrentLastRow)
iRowStartToPaste = iCurrentLastRow + 1
.Range("A" & iRowStartToPaste).Resize(iNumberOfRowToPaste, 1) = rID.Value2
'.Range("B" & iRowStartToPaste).Resize(iNumberOfRowToPaste, 1) = rQuantity.Value2
'.Range("C" & iRowStartToPaste).Resize(iNumberOfRowToPaste, 1) = rUnitPrice.Value2
'.Range("D" & iRowStartToPaste).Resize(iNumberOfRowToPaste, 1) = rKM.Value2
'.Range("E" & iRowStartToPaste).Resize(iNumberOfRowToPaste, 1) = rMC.Value2
End With
End With
End If
Next sh
wk.Close
Next
MsgBox "done in " & Int(Timer - startTime) & "s."
getSpeed (False)
thoat:
Exit Sub
End Sub
Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)
Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function
Những chỗ tôi bôi đỏ là cần phải sửa
Lỗi 1: trang miền giá trị:
Dim iLastRowReport As Integer, iNumberOfRowToPaste As Integer
Khi một biến nhận kiểu Integer tức là giá trị số nguyên của nó chỉ nhận tối đa hơn 32k . Vì thế khi biến này nhận dòng > 35k sẽ gặp lỗi Overfloat (tràn miền giá trị cho phép). Đây chính lỗi bạn phát hiện khi data của bạn > 40k thì lỗi. Vậy khắc phục là đổi Integer thành Long khi đó biến sẽ nhận được gia trị trên 2 tỷ.
Lỗi 2: mất khả năng khôi phục môi trường khi gặp lỗi:
Trong code của bạn bẫy lỗi bị lệch ở đoạn đặt Label "Thoat"
Trước đó bạn đã khóa các chế độ khóa màn hình, khóa sự kiện Excel. Bạn bẫy lỗi bằng On Error Goto Thoat. Như vậy khi lỗi xảy ra thì VBA sẽ nhảy đến lệnh sau label "Thoat". Nhưng code của bạn sau leenhjThoat là không có lệnh khôi phục màn hình, dẫn đến Excel như bị mù, bạn có thể phải CTRL+ALT+DELETE. Vậy khắc phục là sau "Thoat" phải đặt lệnh getSpeed (False)
Code cũ
Mã:
MsgBox "done in " & Int(Timer - startTime) & "s."
getSpeed (False)
thoat:
Exit Sub
Thay thành
Mã:
MsgBox "done in " & Int(Timer - startTime) & "s."
thoat:
getSpeed (False)
Exit Sub
Các vấn đề về logic nhặt dữ liệu thì bạn tự tìm cách khắc phục nhé. Tôi chỉ cho bạn những cái quan trọng và hiểu bản chất để sửa.
File của bạn (không biết có phải code gốc hay không?) nhưng có vài lỗi nghiêm trọng và căn bản trong lập trình VBA mà cần phải hiểu bản chất và khắc phục
Code hiện nay của bạn là:
Mã:
Sub import_data()
Dim maSter As Worksheet, sh As Worksheet
Dim wk As Workbook
Dim strFolderPath As String
Dim selectedFiles As Variant
Dim iFileNum As Integer
Dim strFileName As String
Dim iLastRowReport As Integer, iNumberOfRowToPaste As Integer
Dim rID As Range, rQuantity As Range, rUnitPrice As Range, rKM As Range, rMC As Range
Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
Dim startTime As Double
getSpeed (True)
Set maSter = ActiveWorkbook.Sheets("Sheet1")
strFolderPath = ActiveWorkbook.Path
ChDrive strFolderPath
ChDir strFolderPath
selectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
startTime = Timer
On Error GoTo thoat
For iFileNum = LBound(selectedFiles) To UBound(selectedFiles)
strFileName = selectedFiles(iFileNum)
Set wk = Workbooks.Open(strFileName)
For Each sh In wk.Sheets
If sh.Name Like "To trinh boi thuong" Then
With sh
iLastRowReport = .Range("A" & Rows.Count).End(xlUp).Row
MsgBox ("so dong nguon " & iLastRowReport)
iNumberOfRowToPaste = iLastRowReport - 6 + 1
Set rID = .Range("A6:A" & iLastRowReport)
'Set rQuantity = .Range("C6:C" & iLastRowReport)
'Set rUnitPrice = .Range("E6:E" & iLastRowReport)
'Set rKM = .Range("G6:G" & iLastRowReport)
'Set rMC = .Range("J6:J" & iLastRowReport)
With maSter
iCurrentLastRow = .Range("A" & Rows.Count).End(xlUp).Row
MsgBox ("so dong dich " & iCurrentLastRow)
iRowStartToPaste = iCurrentLastRow + 1
.Range("A" & iRowStartToPaste).Resize(iNumberOfRowToPaste, 1) = rID.Value2
'.Range("B" & iRowStartToPaste).Resize(iNumberOfRowToPaste, 1) = rQuantity.Value2
'.Range("C" & iRowStartToPaste).Resize(iNumberOfRowToPaste, 1) = rUnitPrice.Value2
'.Range("D" & iRowStartToPaste).Resize(iNumberOfRowToPaste, 1) = rKM.Value2
'.Range("E" & iRowStartToPaste).Resize(iNumberOfRowToPaste, 1) = rMC.Value2
End With
End With
End If
Next sh
wk.Close
Next
MsgBox "done in " & Int(Timer - startTime) & "s."
getSpeed (False)
thoat:
Exit Sub
End Sub
Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)
Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function
Những chỗ tôi bôi đỏ là cần phải sửa
Lỗi 1: trang miền giá trị:
Dim iLastRowReport As Integer, iNumberOfRowToPaste As Integer
Khi một biến nhận kiểu Integer tức là giá trị số nguyên của nó chỉ nhận tối đa hơn 32k . Vì thế khi biến này nhận dòng > 35k sẽ gặp lỗi Overfloat (tràn miền giá trị cho phép). Đây chính lỗi bạn phát hiện khi data của bạn > 40k thì lỗi. Vậy khắc phục là đổi Integer thành Long khi đó biến sẽ nhận được gia trị trên 2 tỷ.
Lỗi 2: mất khả năng khôi phục môi trường khi gặp lỗi:
Trong code của bạn bẫy lỗi bị lệch ở đoạn đặt Label "Thoat"
Trước đó bạn đã khóa các chế độ khóa màn hình, khóa sự kiện Excel. Bạn bẫy lỗi bằng On Error Goto Thoat. Như vậy khi lỗi xảy ra thì VBA sẽ nhảy đến lệnh sau label "Thoat". Nhưng code của bạn sau leenhjThoat là không có lệnh khôi phục màn hình, dẫn đến Excel như bị mù, bạn có thể phải CTRL+ALT+DELETE. Vậy khắc phục là sau "Thoat" phải đặt lệnh getSpeed (False)
Code cũ
Mã:
MsgBox "done in " & Int(Timer - startTime) & "s."
getSpeed (False)
thoat:
Exit Sub
Thay thành
Mã:
MsgBox "done in " & Int(Timer - startTime) & "s."
thoat:
getSpeed (False)
Exit Sub
Các vấn đề về logic nhặt dữ liệu thì bạn tự tìm cách khắc phục nhé. Tôi chỉ cho bạn những cái quan trọng và hiểu bản chất để sửa.
Cứ Integer thành Long hết
ActiveWorkbook thành ThisWorkbook, để có đứng ở file khác run macro import_data cũng không bị lỗi.
Đưa getSpeed False xuống dưới Thoat lable
ADO chạy ổn không thì không dám nói.
Nhưng SQL dựa trên cá tính "phẳng" của CSDL. Nếu bảng không "phẳng" thì người dùng phải tự biết chỗ châm chế cho nó.
"Phẳng" có nghĩa là bảng chỉ có 2 chiều. Cộng thêm chiều thứ ba là liên hệ với bảng khác.
Merged cells có thể coi là nằm trong chiều nào là tuỳ theo lý luận của chủ CSDL.
