Tôi kiểm tra lại thấy bình thường mà, bạn nói thiếu dữ liệu là thiếu cái gì?
Chào anh cảm ơn anh đã xem bài..
Sủa lại vầy nha bạn:
With cnn
If Val(Application.Version) < 12 Then
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=Yes;Imex=0"";"
Else
' Fname = .SelectedItems
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1) & ";Extended Properties=""Excel 12.0;HDR=Yes;Imex=0"";"
End If
.Open
'For i = 0 To UBound(shNameNguon)
lsSQL = "SELECT * FROM [DATA$A1:AG65536]"Tôi đã thử nhưng tại sao vẫn không được nhỉ vùng dữ liệu vẫn bị trắng.
Tôi nghĩ ra rồi, khi dùng ADO với Excel nếu cột nào mà nó dò trong vòng 8 hàng đầu tiên mà không có dữ liệu, mặc nhiên nó hiểu cột đó không có gì và nó sẽ bỏ qua. Khắc phục bằng cách nếu kiểm tra dữ liệu gốc, thấy cột nào có hơn 8 hàng bị rỗng, thì điền gì đó vào hàng đầu tiên của cột đó (lưu ý, nếu cột đó dạng Text thì ghi bằng chữ, cột đó dạng Number thì ghi bằng số, trường hợp này là số trong định dạng chuỗi, nên ghi vào hàng đầu tiên là chữ).
Chắc bạn ấy quên kéo thanh cuộn xuống để xem các dòng bên dưới...
Vâng e hiểu rồi..cảm ơn bác chỉ bảo.Em đã thử phương pháp của bác kết quả là OK kể cả khi xóa đi dữ liệu thêm vào và lưu lại thì vẫn cho kết quả đúng,tức là vẫn phải tác động vào file nguồn.Ngoài phương pháp đó có thể khắc phục bằng phương pháp nào không phải tác động file Nguon hoặc code nào khác có thể mở ngầm lấy dữ liệu khộng ạ?
Chỉ có cách dùng workbooks.open ...
Xin nhờ bạn chỉnh giúp câu lệnh trong mã code file đính kèm #1 giúp ạ..!
Theo mình thì khi mà chưa đủ sức thì hãy làm những việc nhẹ trước
Sub Tong_Hop()
Dim sArr(), FilePath As String
FilePath = ThisWorkbook.Path & "\DL_Nguon.xlsm" 'Chú ý câu lệnh này
With Workbooks.Open(FilePath, 0)
With .Sheets("Data")
sArr = .Range("A2", .Range("A" & Rows.Count).End(3).Resize(, 7)).Value
End With
.Close fasle
End With
With Sheets("TH")
.Range("A2", .Range("A" & Rows.Count).End(3)).Resize(, 7).ClearContents
.Range("A2").Resize(UBound(sArr), UBound(sArr, 2)) = sArr
End With
End SubTrường hợp này cũng không giải quyết cho bạn nếu dùng Cstr(F5) được. Giải pháp cho bạn đây:
Sub TongHop3()
Dim cnn As Object, lsSQL As String, lrs As Object ', Fname
Dim Fso As Object, Link As String ', shNameNguon, i As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
Set cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
'shNameNguon = Array("aaa")
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
If .Show = -1 Then
Link = .InitialFileName
Else
MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
Exit Sub
End If
'For Each Fname In .SelectedItems
With cnn
If Val(Application.Version) < 12 Then
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No;Imex=1"";"
Else
' Fname = .SelectedItems
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1) & ";Extended Properties=""Excel 12.0 Xml;HDR=No;Imex=1"";"
End If
.Open
'For i = 0 To UBound(shNameNguon)
lsSQL = "SELECT * FROM [DATA$A1:AG65536]"
lrs.Open lsSQL, cnn, 3, 1
Sheets("TH").Range("A1:AG65536").ClearContents
Sheets("TH").Range("A1").CopyFromRecordset lrs
lrs.Close
'Next
End With
'Next
End With
Application.ScreenUpdating = True
cnn.Close
Set lrs = Nothing
Set cnn = Nothing
End SubNó là kiểu số trong định dạng chuỗi (kiểu mã số, số hóa đơn, số vận đơn v.v...).
Lý do tôi sử dụng chạy ngầm là vì nếu sử dụng open wordbook có vấn đề ở chỗ file nguồn trích suất bởi một phần mềm trung gian..khi mở có cảnh báo cập nhật.và lỗi nữa có code tự đông..trường hợp lỗi code khi mở phải tắt lỗi file nguồn như phương pháp bác @Quang_Hải đưa ra rồi thực thi lại code.Còn mở bằng phương pháp ngầm sẽ không phải tác động gì file nguồn ạ
Ở bài #14 tôi nghĩ đã giải quyết vấn đề của bạn rồi phải không?
Vâng anh ..tôi trả lời câu hỏi phụ của anh ..tại sao phải sử dụng phương pháp mở ẩn ..ngoài ra nếu để HDR=No khi muốn lọc dữ liệu tại mệnh đề Where thay vì f1,f2,f3...sẽ phải nêu rõ tiêu đề đúng kg ạ
F1, F2, ... Fn là tên gọi cột không được xác định tiêu đề, vì vậy bạn có thể dùng nó để xử lý dữ liệu theo điều kiện đặt ra. Nhưng với bài #14 mà tôi gọi là "lách luật", nó sẽ gặp khó khăn cho bạn nếu ORDER BY vì rất có thể tiêu đề của nó không còn nằm ở vị trí đầu tiên.
Vâng cảm ơn anh đúng là vậy phương pháp lách luật của a cũng là một phương pháp hay để tránh 8 dòng trống đầu tiên...nếu không còn phương pháp khác thì thực cảm ơn bác và anh chị e đã tận tình chỉ bảo.
Dùng ADO lấy dữ liệu Excel nó vẫn còn nhiều hạn chế do đó phải chấp nhận có sự điều chỉnh hoặc dùng phương pháp khác.
Vâng tôi hiểu rồi ạ..Xin cảm anh chị em đã chỉ bảo!
Vâng tôi hiểu rồi ạ..Xin hỏi bạn và anh chị em một vấn đề cuối.
Nhờ bác @Quang_Hải xem giúp.Với code trên khi đến dòng lệnh mỏ file nguồn(Workbooks.Open) file nguồn được mở lên và hiện cảnh báo lỗi code như hình dưới.Vậy mình phải sử dụng câu lệnh gì để bỏ qua lỗi đó thay vì phải bấm END để đồng thời mở 2 file rồi thực thi lại code trên mới lấy được dữ liệu ạ!
Trong câu lệnh này dưới đây trong thủ tục đó:
Cảm ơn anh tôi đã thử nhưng không có kết quả.Bảng thông báo đó là lỗi của File nguồn khi được kích hoạt mở,tự chạy code chứ không phải lỗi code thực thi.Tôi muốn nhờ đặt câu lệnh để ngăn không cho file nguồn mở lên chạy code..Tôi gửi file cả nhà mình xem giúp.
Lỗi do code của file nguồn chứ liên quan gì đến code của Quang Hải đâu bạn?
Vâng ạ..tôi vẫn giải thích là lỗi file nguồn nên muốn nhờ đặt câu lệnh trong đoạn code Quang Hải để bỏ qua báo lỗi đó và tiếp tục thực thi code lấy dữ liệu ạ
Cảm ơn bạn đã quan tâm..bản chất file nguồn được xuất bằng phần mềm tự động của công ty luôn chứa mã code để chạy các định dạng khác trong file nên mới sảy ra lỗi như trên..
Có nhiều cách, nhưng bạn thử cách đơn giản nhất là copy đoạn code này vào xem:
Phương pháp này hình như không có tác dụng tôi cũng đã nghĩ đến và đã thử..bởi khi code nguồn kích hoạt thì code thực thi bị ngắt kg hoạt động
Gán câu lệnh đó trong code sheet Nguon xem sao.
Hình như sự việc cũng không ghê gớm lắm đâu
Sub Tong_Hop()
Application.EnableEvents = False 'câu lệnh này sẽ chặn sự kiện của file nguồn
Dim sArr(), i As Long, FilePath As String
FilePath = ThisWorkbook.Path & "\DL_Nguon.xlsm"
With Workbooks.Open(FilePath, 0)
With .Sheets("Data")
sArr = .Range("A2", .Range("A" & Rows.Count).End(3).Resize(, 7)).Value
End With
.Close fasle
End With
With Sheets("TH")
.Range("A2", .Range("A" & Rows.Count).End(3)).Resize(, 7).ClearContents
.Range("A2").Resize(UBound(sArr), UBound(sArr, 2)) = sArr
End With
Application.EnableEvents = True
End SubĐúng là không ghê gớm đối với nhiều người ghê gớm như các bác...
