Code VBA Lấy dữ liệu từ File khác bằng SQL

5 Responses

1. hands says:

   31/01/2023 at 9:37 am

   Dear Anh,
   E có dùng File nhưng nó không chạy được và báo lỗi đoạn màu vàng này ạ "rst.Open sql, cn, 3, 1". Anh xem giúp em với ạ.

   Bạn tự ý sửa cú pháp bắt buộc của của người ta nên code nó chạy sai là đúng rồi. Các ký hiệu F5, F1 là ký hiệu đại diện cho cột thứ 5 (Field 5) chứ không phải địa chỉ cột của Excel nhé.

   Tôi cũng có một góp ý về cách tổ chức xử lý bảng tính của bạn (mà tôi thấy cũng nhiều người có cùng kiểu xử lý giống bạn) là:
   Khi bạn muốn tìm kiếm, lọc dữ liệu một file data nào đó thì cũng nên phân tích kỹ, "tính trước" nhưng trường hợp truy vấn có thể phát sinh (có thể bây giờ chưa cần nhưng sau có khi cần) để đưa ra hết các điều kiện lọc dữ liệu lên UserForm hay Sheet rồi viết code một lần để lọc theo tất cả các điều kiện đó, khỏi phải lắc nhắc, sau này phát sinh rồi lại sửa code, nếu lúc đó không có ai hỗ trợ bạn thì sao.

   2699

   Dạ Vâng ạ. Em ngồi mày mò lấy số liệu cũng yêu cầu trên nhưng em không dùng SQL nữa mà em dùng Advanfilter để lọc. Để làm việc này em bố trí lại điều kiện lọc như tại Sheet Bao Cao (Chỗ hai cái ngày, Code phải như thế nào để nó hiểu nó lọc từ tháng 1,2,3,4 chứ không phải chỉ lọc có tháng 1 và 4 ạ). Anh xem giùm em với ạ. Em cảm ơn anh.

   Bạn thiết lập điều kiện cho Advance filter thiết và khai báo range sai nên code không hiểu.
   Tôi sửa đoạn code trong file bạn như bên dưới, bạn thay lại đường dẫn theo máy bạn.
   Ở range lưu điều kiện cho Advance Filter, bạn thêm dấu >= cho và <= cho

   Sub OpenImp3()
       Const sPath = "\MacHomeDownloadsNKBH.xlsx"
       Dim owb As Workbook
   
   Dim Rng As Range
       Dim TK As Range
   
   Set TK = Sheet3.Range("B2:D3")
   
   If Dir(sPath) <> "" Then
           Set owb = Workbooks.Open(sPath)
           Set Rng = owb.Sheets("Sheet1").Range("A1:J" & owb.Sheets("Sheet1").Range("J" & Rows.Count).End(xlUp).Row)
           With Sheet1
               .Range("A1:J65535").ClearContents
               Rng.AdvancedFilter 2, TK, .Range("A1:J10000")
           End With
           owb.Close False
       End If
   End Sub

   Dear Anh,
   Em đã làm đúng như a Hướng dẫn thêm nhưng em vẫn không lấy dữ liệu vào được ạ. Lấy được một cái tiêu đề ạ. Không biết em đang làm sai gì mà không chạy được anh ạ. Em nghĩ cái đoạn này Set TK = Sheet3.Range("B2:D3") không biết có đúng không nếu thêm dấu lớn hơn, bằng, nhở hơn như đã thiết lập điều kiện tìm tại Sheet Bao cao ạ. A xem giúp em với ạ.

   – Điều kiện cho Advance Filter dạng Date mà bạn lại dùng công thức chuyển nó thành Text thì làm sao nó tìm ra được. =C4 & TEXT(C6:"dd/mm/yyy")
   – Mấy điều kiện lọc này có 3 ô, gõ tay vô được rồi, tại sao phải dùng công thức nữa chi cho rắc rối cuộc đời. Bạn cứ gõ đúng định dạng ngày tháng trên máy tính là được.

   Em làm đươc rồi ạ. Em cảm ơn anh nhiều ạ !!!

   Reply
2. hands says:

   31/01/2023 at 9:38 am

   Dear Anh,
   Em muốn nhờ anh giúp em thêm chút nữa với ạ.
   Tiếp theo ý trên em muốn thêm điều kiện sau thì thực hiện thế nào ạ.

   (1) Vì cái đường dẫn "D:SQLNKBH.xlsx", em muốn chủ động thay đổi bên ngoài mà không cần vào code để sửa thì em định làm như sau: Tại Sheet Bao cao em đặt tại ô E3 = D:SQLNKBH.xlsx như File. Thế giờ đoạn Code là Const sPath = "D:SQLNKBH.xlsx" em phải sửa thế nào ạ.
   Em thử làm là :

   Set Diachi = Sheet3.range ("E3")

   Const sPath = "Diachi"

   Nhưng nó toàn báo lỗi ạ.

   (2) Sau khi lấy dữ liệu xong rồi. Em muốn đặt tên cho vùng có dữ liệu từ vùng A:L bằng cách vào thẻ Tab để add thêm Table với tên là Saoke. Em đã làm đoạn Code theo File kèm theo mà nó cứ báo lỗi. Anh xem giúp em với ạ

   Tôi cũng định đề xuất bạn làm kiểu này, Bạn đang suy nghĩ lập trình dần dần đúng hướng rồi đó, giảm thiểu việc can thiệp vô code nhiều khi có thay đổi.
   Mục 2: bạn nên đặt tên trước cho cái cùng dữ liệu (chỉ cần vài dòng dữ liệu), sau đó dùng cái hàm tạo Name động cập nhật lại range. Tại sao tôi đề xuất bạn đặt tên range trước vì theo như cách bạn đề xuất: khai báo cứng (hard code) trong code vùng (A:L), sau này muốn thay đổi cột thì lại phải vô code sửa. Nếu khai báo tên Range thì khi thay đổi vùng bạn chỉ cần làm thủ công tạo Named range cho cùng mới rồi chạy code thôi.
   – Tôi thêm vô 2 cái module: hàm lấy tên file và hàm tạo name động.
   – Hiện tại thì khi bấm nút [Tổng hợp Data], nó sẽ hiện hộp thoại yêu cầu trỏ đường dẫn tới file lấy dữ liệu luôn.
   – Ở kế ô "E3", tôi có thêm cái nút để lấy đường dẫn file lưu vào ô "E3". Nếu bạn không muốn mỗi khi bấm nút [Tổng hợp] rồi chọn đường dẫn thì làm cách này. Trong code đổi lại chút ở đoạn tham chiếu đến file dữ liệu.
   sPath = GetFileOpen
   —> đổi lại sPath = ActiveSheet.Range("E3").Value

   Dạ vâng ạ. Em sẽ ngâm cứu thêm ạ.Em cảm ơn anh nhiều ạ !!!

   Reply
3. hands says:

   31/01/2023 at 9:39 am

   Dear Anh,
   Bỏ qua cái đặt tên vùng. Mà tập trung vào cái địa chỉ ô E3 – Dường dẫn dữ liệu. Em xem code mà thấy khó thật ạ. Em không nghĩ nó lại phức tạp đến vậy ạ. Em chỉ nghĩ đâu đó bẫy gì đó để lấy được đường dẫn vào kiểu như dưới ạ. Còn cách gì đơn giản hơn không a nhỉ.

   Set Diachi = Sheet3.range ("E3")

   Const sPath = "Diachi"

   Mấy code lấy tên file, tạo name động thì bạn cứ copy vô dự án mà xài thôi. Khi nào rảnh thì ngâm cứu học hỏi nó tại sao nó chạy như vậy.
   Muốn tự động, không phải gõ thủ công đường dẫn thì phải thêm code cho nó là bình thường.

   Nếu bạn muốn đơn giản hơn thì cứ thông qua đặt tên range (define named range) mà truyền tham số vào code.
   – Bạn đặt tên range cho ô "E3" là: sPath. Sau này đổi địa chỉ sang ô khác thì cũng chỉ cần đặt tên đúng như vậy là được rồi.
   – Code: khai báo biến sPath = Range("sPath")

   (bạn ngâm cứu đặt tên cho cái range điều kiện tìm kiếm giống vậy luôn đi)
   Set TK = Range("DKTiemKiem")

   Option Explicit
   
   Sub LayData()
   
   Dim owb As Workbook
       Dim Rng As Range
       Dim TK As Range, SaoKe As Range
       Dim tbl As ListObject
       Dim sPath As String
       Set TK = Sheet3.Range("B2:D3")
   
   'sPath = GetFileOpen    '--> Dùng hàm lay duong dan file
   
   sPath = Range("sPath")  '--> Khai báo Named range cho Cell chua duong dan
   
   If Len(sPath) = 0 Then Exit Sub     'Khong chon file nao
   
   Set owb = Workbooks.Open(sPath)
       Set Rng = owb.Sheets("Sheet1").Range("A1:J" & owb.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
       With Sheet1
           .Range("A1:J65535").ClearContents
           Rng.AdvancedFilter 2, TK, .Range("A1:J65535")
       End With
       owb.Close False
   
   Call createDynamicNamedRange("Data", "SaoKe")
   
   End Sub

   Dear Anh,
   Em đã làm được rồi ạ. Anh thật Pro ạ. Em cảm ơn Anh nhiều !!!

   Reply
4. hands says:

   31/01/2023 at 9:42 am

   Dear Anh,
   E hỏi thêm chút với ạ. Em đã làm được Code và áp dụng cho việc Upload dữ liệu từ hai File vào 2 sheet với cách làm tương tự nhau và đã chạy được độc lập nhau. Nhưng em muốn làm một nút lệnh bấm một lần cho chay bằng

   Sub Gop
   Call LayData
   Call LayData1
   Em sub

   (1) Nhưng giả sử khi Sub LayData không chạy thì nó lại không chạy LayData1 trong khi LayData1 khả dụng . Mà em hiểu rằng dù một trong hai Sub không khả dụng thì nó vẫn phải chạy cái khả dụng chứ ạ. Có cách gì bẫy chỗ này không ạ.
   (2) Thêm thông báo với nếu ô E3 rỗng hoặc đường dẫn không đúng/không tìm ra a. Thì em thấy nó không chạy ạ. Đoạn em bôi đậm ạ. A xem giúp em với ạ.

   Sub LayData()
   Dim owb As Workbook
   Dim Rng As Range
   Dim TK As Range
   'Dim tbl As ListObject
   Dim sPath As String
   Set TK = Sheet7.Range("G2:I3")

   ' Define Name cho E3 tai Sheet Khai Bao có tên là sPath
   sPath = Range("sPath")

   If Len(sPath) = 0 Then 'MsgBox " The Link to Update SKTD is not available !"
   Exit Sub
   

   If Dir(sPath) <> "" Then
   Set owb = Workbooks.Open(sPath)
   Set Rng = owb.Sheets("Sheet1").Range("A1:BM" & owb.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
   With Sheet4
   .Range("A2:BQ60000").ClearContents
   Rng.AdvancedFilter 2, TK, .Range("A1:BM60000")
   End With
   owb.Close False
   Application.ScreenUpdating = False
   End If

   End Sub

   Bạn xem lại cách dùng If Then Else nhé.
   Sửa lại:

   If Len(sPath) = 0 Then 'Khong chon file nao
           MsgBox "The Link to Update SKTD is not available!"
           Exit Sub
       End If
   
   If Len(Dir(sPath)) = 0 Then
           MsgBox "Duong dan file sai!"
           Exit Sub
       End If

   Còn việc chạy 2 cái Sub mà cái 1 sai nó thoát chắc do lệnh Exit Sub hoặc báo lõi hệ thống gì đó nó ngưng cái Sub Gop luôn.
   Nó có hiện thông báo lỗi gì không?
   Bạn đổi tên Sub LayData thành Function LayData và dùng lệnh Exit Function thay thế Exit sub trong đó thử xem.

   Chuẩn không cần chỉnh Anh ạ ! Với A em thấy không có gì là không thể ạ. Cảm ơn A ạ !!!

   Reply
5. hands says:

   31/01/2023 at 9:42 am

   Bạn thử cái này.

   Sub ImportData_Test()
   Dim owb As Workbook
   Dim cn As Object, pro As String, EXT As String, name As String, sql As String, ngay1 As Long, ngay2 As Long, ten As String
   With Sheets("bao cao")
        ngay1 = .Range("C3").Value2
        ngay2 = .Range("c4").Value2
        ten = .Range("C2").Value
   End With
   Dim rst As Object
   'On Error Resume Next
   Set rst = CreateObject("ADODB.recordset")
   Set cn = CreateObject("ADODB.Connection")
        Sheets("Data").Range("A2:J10000").ClearContents
        name = ThisWorkbook.Path & "NKBH.xlsx"
        pro = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
        EXT = ";Extended Properties=""Excel 12.0;HDR=No;"";"
        cn.Open (pro & name & EXT)
        sql = "SELECT * from [sheet1$A1:J100000]  WHERE F5=" & "'" & ten & "'" & "AND F1 BETWEEN " & ngay1 & " and " & ngay2 & ";"
       rst.Open sql, cn, 3, 1
           Sheet1.Range("A2").CopyFromRecordset rst
        rst.Close
       cn.Close
   End Sub

   AD ƠI CỘT F5 là gì vậy? xin hướng dẫn ạ>

   F5 là cột 5 đó bạn, cụ thể là cột E (Ten Cong ty trong file NKBH) đó.

   Reply