Maika8008
Thành viên gạo cội
- Tham gia
- 12/6/20
- Bài viết
- 4,741
- Được thích
- 5,669
- Donate (Momo)
- Giới tính
- Nam
Với Excel chúng ta thường có nhu cầu lọc lựa, lấy dữ liệu từ 1 file đang trạng thái đóng đã biết trước đường dẫn và địa chỉ tham chiếu vùng dữ liệu, nhưng lại không muốn tự tay mở nó ra để chép 1 cách thủ công qua file đang làm. Với VBA, chúng ta có 3 cách để tự động hóa khâu lấy dữ liệu này.
Cách 1: Mở trực tiếp file lên, lấy dữ liệu xong đóng lại:
- Ưu điểm của cách 1 là trực quan, ta có thể tạm ngừng lệnh, chạy từng bước để xem kết quả trung gian. Dữ liệu có thế nào chép sang thế ấy hoặc có thể tùy ý chép riêng định dạng, công thức, giá trị…
- Nhược điểm cách 1 là thời gian thực thi khá chậm, mất khoảng 1,4 giây cho việc mở file, chép dữ liệu, đóng file. (Thời gian ở đây là trong điều kiện thử nghiệm cụ thể của tác giả, chỉ để so sánh tốc độ thực hiện các cách với nhau. Thời gian đó sẽ khác đi khi dùng ở máy khác, dùng 1 file nguồn khác…)
Cách 2: Mở file bằng ADODB:
- Ưu điểm của cách 2 là thực thi nhanh, chỉ mất cỡ 0,2 giây, và người dùng không nhận biết được file đóng mở.
- Nhược điểm cách 2 là:
+ Trong đa số trường hợp phải mất công khắc phục việc chạy lệnh đối với tiêu đề có dấu tiếng Việt (Có cách khác không bị ảnh hưởng bởi tiêu đề tiếng Việt. Nhưng vấn đề này sẽ được trình bày ở 1 bài khác, có sự so sánh việc sử dụng của 2 cách).
+ Những ai chưa rành cú pháp SQL và lồng các biến vào câu lệnh SQL có thể gặp trở ngại khi điều kiện truy vấn phức tạp.
+ Gặp dữ liệu có dấu phân cách thập phân với các máy đã được dịnh dạng trong Control Panel là dấu phẩy thì sẽ có rắc rối với kết quả chép ra. Thay vì đúng là 144,12 thì kết quả chép ra ở đây là 14412,00.
Để khắc phục nhược điểm này thì phải thêm mã lệnh để chuyển định dạng dấu phẩy thập phân trong Control Panel sang dấu chấm trước khi chạy truy vấn rồi chuyển lại dấu phẩy ngay sau truy vấn.
Khai báo và đặt hàm SetLocalSetting trên đầu Module:
Với Sub GetDataByADODB() ở trên, thêm lệnh này trước lệnh truy vấn SQL:
Call SetLocalSetting(LOCALE_SDECIMAL, ".")
Và thêm lệnh này ngay sau khi chạy xong truy vấn SQL:
Call SetLocalSetting(LOCALE_SDECIMAL, ",")
Cách 3: Dùng Macro 4. Cách này tôi dùng code từ nguồn:
https://www.giaiphapexcel.com/diendan/threads/dùng-macro-4-để-lấy-dữ-liệu-từ-1-file-đang-đóng.39312/
Với cách này, dù dữ liệu nguồn sAddr = "A1
100" nhưng khi muốn hiển thị kết quả ít hơn thì bạn giảm kích thước vùng kết quả chỗ Sheets("KQ").Range("A1100"). Nếu tăng kích thước vùng kết quả thì sẽ bị #N/A ở các ô thừa.
- Thực tình thì không thấy ưu điểm nào của cách này ngoài việc nó lấy đúng số liệu nguồn như cách 1. Còn nhược điểm là quá chậm, phải đến tận 5 giây (gấp hơn 3 lần cách 1) thì mới lấy được dữ liệu cùng cỡ với các cách trên. Dòng tiêu đề sẽ hiển thị là 0 với tiêu đề nào chừa trống.
P/S: Tôi đính kèm file dữ liệu mà tôi đã dùng để test tốc độ thực thi code để các bạn có cùng 1 mẫu thử.
Trong bài có chỗ nào sai, sót thì các bác "gội" rồi mới "cạo" nhẹ nhàng góp ý giúp.
Cách 1: Mở trực tiếp file lên, lấy dữ liệu xong đóng lại:
Rich (BB code):
Sub GetDataByOpenFile()
Dim Wb As Workbook, WbS As Workbook
Dim sFullName$, tmr#
tmr = Timer()
Application.ScreenUpdating = False
sFullName = "D:\GoogleDrive2\CaNhan\VBA\MapVN.xlsx" 'Duong dan file du lieu
Set Wb = ThisWorkbook
Set WbS = Workbooks.Open(sFullName)
WbS.Sheets("VNxy").Range("A1:D100").Copy Wb.Sheets("KQ").Range("A1")
WbS.Close False
Application.ScreenUpdating = True
Msgbox Timer() – tmr 'Thoi gian thuc hien
End Sub- Nhược điểm cách 1 là thời gian thực thi khá chậm, mất khoảng 1,4 giây cho việc mở file, chép dữ liệu, đóng file. (Thời gian ở đây là trong điều kiện thử nghiệm cụ thể của tác giả, chỉ để so sánh tốc độ thực hiện các cách với nhau. Thời gian đó sẽ khác đi khi dùng ở máy khác, dùng 1 file nguồn khác…)
Cách 2: Mở file bằng ADODB:
Rich (BB code):
Sub GetDataByADODB()
Dim Rec As Object, rs As Object
Dim sFullName$, iCol&, tmr#
tmr = Timer()
sFullName = "D:\GoogleDrive2\CaNhan\VBA\MapVN.xlsx" 'Duong dan file du lieu
Application.ScreenUpdating = False
Set Rec = CreateObject("ADODB.Connection")
With Rec
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & sFullName & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
.Open
End With
Set rs = Rec.Execute("Select * From [VNxy$A1:D100]")
Sheets("KQ").Range("A2").CopyFromRecordset rs
For iCol = 0 To rs.Fields.Count - 1 'Chep tieu de cọt
Sheets("KQ").Cells(1, iCol + 1).Value = rs.Fields(iCol).Name
Next
Set rs = Nothing
Msgbox Timer() – tmr 'Thoi gian thuc hien
Application.ScreenUpdating = True
End Sub- Nhược điểm cách 2 là:
+ Trong đa số trường hợp phải mất công khắc phục việc chạy lệnh đối với tiêu đề có dấu tiếng Việt (Có cách khác không bị ảnh hưởng bởi tiêu đề tiếng Việt. Nhưng vấn đề này sẽ được trình bày ở 1 bài khác, có sự so sánh việc sử dụng của 2 cách).
+ Những ai chưa rành cú pháp SQL và lồng các biến vào câu lệnh SQL có thể gặp trở ngại khi điều kiện truy vấn phức tạp.
+ Gặp dữ liệu có dấu phân cách thập phân với các máy đã được dịnh dạng trong Control Panel là dấu phẩy thì sẽ có rắc rối với kết quả chép ra. Thay vì đúng là 144,12 thì kết quả chép ra ở đây là 14412,00.
Để khắc phục nhược điểm này thì phải thêm mã lệnh để chuyển định dạng dấu phẩy thập phân trong Control Panel sang dấu chấm trước khi chạy truy vấn rồi chuyển lại dấu phẩy ngay sau truy vấn.
Khai báo và đặt hàm SetLocalSetting trên đầu Module:
Rich (BB code):
#If VBA7 Then
Private Declare PtrSafe Function SetLocaleInfo _
Lib "kernel32" Alias "SetLocaleInfoA" ( _
ByVal Locale As LongPtr, _
ByVal LCType As LongPtr, _
ByVal lpLCData As String) As Boolean
Private Declare PtrSafe Function GetUserDefaultLCID% Lib "kernel32" ()
#Else
Private Declare Function SetLocaleInfo _
Lib "kernel32" Alias "SetLocaleInfoA" ( _
ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String) As Boolean
Private Declare Function GetUserDefaultLCID% Lib "kernel32" ()
#End If
Private Const LOCALE_SDECIMAL = &HE
Private Function SetLocalSetting(LC_CONST As Long, Setting As String) As Boolean
Call SetLocaleInfo(GetUserDefaultLCID(), LC_CONST, Setting)
End FunctionCall SetLocalSetting(LOCALE_SDECIMAL, ".")
Và thêm lệnh này ngay sau khi chạy xong truy vấn SQL:
Call SetLocalSetting(LOCALE_SDECIMAL, ",")
Cách 3: Dùng Macro 4. Cách này tôi dùng code từ nguồn:
https://www.giaiphapexcel.com/diendan/threads/dùng-macro-4-để-lấy-dữ-liệu-từ-1-file-đang-đóng.39312/
Rich (BB code):
Sub GetDataByMacro4()
Dim tmr#
tmr = Timer()
Dim sFile As String, sSheet As String, sAddr As String
sFile = "D:\GoogleDrive2\CaNhan\VBA\MapVN.xlsx"
sSheet = "VNxy"
sAddr = "A1:D100"
Sheets("KQ").Range("A1:D100") = GetData(sFile, sSheet, sAddr)
'Kích thuoc phai bang sAddr
Msgbox Timer() – tmr 'Thoi gian thuc hien
End Sub
Function GetData(sFile As String, sSheet As String, sAddr As String)
Dim pLink As String, iR As Long, iC As Long, Arr
If Len(Dir(sFile)) Then
Arr = Range(sAddr)
pLink = "'" & Replace(sFile, Dir(sFile), "[" & Dir(sFile) & "]") & sSheet & "'!"
For iR = 1 To Range(sAddr).Rows.Count
For iC = 1 To Range(sAddr).Columns.Count
Arr(iR, iC) = ExecuteExcel4Macro(pLink & Range(sAddr). _
Cells(iR, iC).Address(, , 2))
Next iC
Next iR
GetData = Arr
End If
End Function- Thực tình thì không thấy ưu điểm nào của cách này ngoài việc nó lấy đúng số liệu nguồn như cách 1. Còn nhược điểm là quá chậm, phải đến tận 5 giây (gấp hơn 3 lần cách 1) thì mới lấy được dữ liệu cùng cỡ với các cách trên. Dòng tiêu đề sẽ hiển thị là 0 với tiêu đề nào chừa trống.
P/S: Tôi đính kèm file dữ liệu mà tôi đã dùng để test tốc độ thực thi code để các bạn có cùng 1 mẫu thử.
Trong bài có chỗ nào sai, sót thì các bác "gội" rồi mới "cạo" nhẹ nhàng góp ý giúp.
)
