ADO gọi data file đóng với các cột được liệt kê

[tieuthubuongbinh]

Chào các bác,

Các bác viết giùm em code cho file đóng với đường dẫn của file ở A2 và tên sheet A3.
Tiêu đề được liệt kê thì sẽ chỉ gọi data đó lên (vd của em là 5 cột), tuy nhiên nếu em để thêm tiêu đề vào thì nó sẽ được liệt kê theo dòng tiêu đề đó (vd em chỉ để 4 cột tiêu đề hoặc 6 cột tiêu đề thì nó dò tìm đúng cột để hiện ra - thức tự cột có thể ko giống nhau).
Nếu tiêu đề không giống file nguồn thì hiện msg box "Không tìm thấy tiêu đề này"
File gốc format cột như thế nào thì data hiện ra giữ nguyên format đó (vd data gốc là text thì hiện ra là text, data gốc là number thì hiện ra là number)

Em cám ơn các bác ạ
Thân
TTBB

 

[ducdoom]

Xin chào!
mình giúp bạn code này bằng ADO, vì mình không có dữ liệu của bạn nên khó test được
nhưng mình test với dữ liệu của mình thì thấy cũng ok đó
code có trong file, mình copy xuống dưới đây cho mọi người cùng tham khảo

Option Explicit

Sub GetDataGPE()
    
    Dim ws As Worksheet
    Set ws = ActiveSheet
    ws.Range("A6", "A" & ws.Rows.Count).EntireRow.ClearContents
    
    '//get excel file name and sheetname which contains data
    Dim excelFile As String
    excelFile = ws.Range("A2").Value2
    Dim sheetDataName As String
    sheetDataName = ws.Range("A3").Value2
    
    '//get headers to show in the report
    Dim lastCol As Integer
    lastCol = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
    
    Dim headersArray As Variant
    ReDim headersArray(1 To lastCol) As String
    Dim i As Integer
    For i = LBound(headersArray) To UBound(headersArray)
        headersArray(i) = ws.Cells(5, i).Value2
    Next
      
    Dim headersToSelect As String
    headersToSelect = "[" & Join(headersArray, "],[") & "]"
    
    '//ADODB
    Dim conn As Object
    Set conn = CreateObject("ADODB.Connection")
    Dim cnnString As String
    cnnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & excelFile & ";" & _
                "Extended Properties=""Excel 12.0 Xml; HDR=YES; IMEX=0"";"
    
    conn.Open cnnString
    Dim rs As Object
    Set rs = CreateObject("ADODB.Recordset")
    
    Dim SQLquery As String
    SQLquery = "select " & headersToSelect & " from [" & sheetDataName & "$];"
    Set rs = conn.Execute(SQLquery)
    
    '//fill data
    If Not rs.EOF Then
        ws.Range("A6").CopyFromRecordset rs
    Else
        MsgBox "khong tim thay tieu de"
    End If
                
    '//close ADODB
    rs.Close
    Set conn = Nothing
    Set rs = Nothing

End Sub

 

[tieuthubuongbinh]

Xin chào!
mình giúp bạn code này bằng ADO, vì mình không có dữ liệu của bạn nên khó test được
nhưng mình test với dữ liệu của mình thì thấy cũng ok đó
code có trong file, mình copy xuống dưới đây cho mọi người cùng tham khảo

Option Explicit

Sub GetDataGPE()

End Sub

Mình test thử thì thấy ổn rồi bạn, tuy nhiên bạn chỉnh giúp mình thêm vài ý sau nhé (vì mình dùng rồi mới phát hiện có 1 số thứ chưa thuận tiện)

1. excelFile = ws.Range("A2").Value2 => khi mình để "Workbook" thì nó hiểu là lấy ở chính file đang làm. Còn để tên folder thì lấy ở file đóng đó
2. Khi mình tô màu A2 là màu gì thì khi nó hiện tiêu đề đến đâu thì nó tô đúng màu đó cho dòng tiêu đề
3. ws.Range("A6", "A" & ws.Rows.Count).EntireRow.ClearContents => như vậy thì nó sẽ ko clear entirerow mà sẽ xóa đúng khu vực tô màu của A2 thôi (từ dòng tiêu đề trở xuống) vì có khi mình gọi data lên rồi mình làm thêm nhiều cột kế tiếp, nên mình cần giữ lại, và vì code xài chung cho nhiều format nên cần xóa đúng cái gì đã hiện

Mình gửi lại file với thêm 1 kiểu data để bạn test cho tiện. Sheet Load 2 là mình làm để bạn thử trên sheet Load luôn nha (nghĩa là mình chỉ cần 1 sheet Load mà đổi data kiểu Load 2 nó vẫn chạy ổn)

Cám ơn bạn nhiều lắm
PS: mình thích cách chú thích đoạn code của bạn lắm, mình ko biết nhiều về VBA nên nhìn vào thì hiểu đoạn đó dùng để làm gì

 

[ducdoom]

Mình gửi lại bạn file
code khá cồng kềnh
hóng cao nhân giúp mình xử lý vấn đề Tiêu đề trong data source có chứa ký tự chấm ( . ) khi dùng ADO trích xuất dữ liệu từ file Excel
để code bớt cồng kềnh

 

[ptm0412]

... xử lý vấn đề Tiêu đề trong data source có chứa ký tự chấm ( . ) khi dùng ADO trích xuất dữ liệu từ file Excel
để code bớt cồng kềnh

Bạn khỏi băn khoăn về chuyện này. Tiêu đề của bảng tính cần sử dụng ADO cũng như tên field của Table dữ liệu không được đặt bao gồm những ký tự đặc biệt. Ký tự đặc biệt có đến hàng chục và bạn không thể bắt hết, do đó người dùng phải tự biết và làm đúng trước khi dùng ADO.

 

[tieuthubuongbinh]

@ducdoom không ổn bạn ơi
Vì mình để trống tiêu đề thì code vẫn đang hiện ra data, đúng lý nó phải ko có data ở cột này luôn (vì làm sao nó hiểu là lấy data cột nào)



Khi mình để 2 cột qua E và F mà nó vẫn ra data ở cột C và D (sao nó ko dời theo?)

 

[ducdoom]

điều này bạn nên nói sớm hơn mới phải

 

[ptm0412]

điều này bạn nên nói sớm hơn mới phải

Bạn viết code chung chung thôi, bắt người dùng tham gia vào. Thí dụ InputBox "Vậy chứ mi muốn dữ liệu từ đâu đến đâu, các cột tên gì"
Và không cho bỏ trống tên cột ở giữa, đó là nguyên tắc CSDL, không chiều nhỏ tieuthubuongbinh này
Mai nó lại muốn bỏ trống cột A, B bắt đầu từ cột C thì bạn sẽ phải chiều nó lần nữa

 

[ducdoom]

không chiều nhỏ tieuthubuongbinh này

Bác nói chí phải, em sẽ nghe lời bác

 

[HieuCD]

@ducdoom không ổn bạn ơi
Vì mình để trống tiêu đề thì code vẫn đang hiện ra data, đúng lý nó phải ko có data ở cột này luôn (vì làm sao nó hiểu là lấy data cột nào)

View attachment 223301

Khi mình để 2 cột qua E và F mà nó vẫn ra data ở cột C và D (sao nó ko dời theo?)

View attachment 223302

Thử code

Option Explicit

Sub GetDataCot()
  Dim cn As Object, Dic As Object, iKey As String
  Dim wb As Workbook, ws As Worksheet, tdRng As Range
  Dim fileName As String, shName As String
  Dim sArr, Res(), colArr()
  Dim i&, j&, k&, sCol&, jC&, sRow&
 
  On Error Resume Next
  Set tdRng = Application.InputBox(prompt:="Chon vùng Tieu De", Type:=8)
  If Err.Number > 0 Then
    MsgBox ("Phai chon Tieu De")
    On Error GoTo 0
    Exit Sub
  End If
 
  Set Dic = CreateObject("Scripting.Dictionary")
  For j = 1 To tdRng.Columns.Count
    iKey = tdRng(1, j)
    If Len(iKey) Then
      Dic.Item(iKey) = j
      sCol = j
    End If
  Next j
  i = tdRng(1, 1).Offset(1000000, 0).End(xlUp).Row
  If i > 5 Then tdRng(1, 1).Offset(1, 0).Resize(i - 5, j - 1).Clear
 
  Set ws = tdRng.Parent
  Set wb = ws.Parent
  fileName = ws.Range("A2").Value
  If LCase(fileName) = "workbook" Then fileName = wb.FullName
  shName = ws.Range("A3").Value & "$"
  Set cn = CreateObject("ADODB.Connection")
  cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fileName & ";Extended Properties=""Excel 12.0;HDR=No"""
  sArr = cn.Execute("select * from [" & shName & "] where f1 is not null").GetRows
  cn.Close: Set cn = Nothing

  If Err.Number = 0 Then
    For i = 0 To UBound(sArr, 1)
      jC = Dic.Item(sArr(i, 0))
      If jC > 0 Then
        k = k + 1
        ReDim Preserve colArr(1 To 2, 1 To k)
        colArr(1, k) = jC
        colArr(2, k) = i
      End If
    Next i
    If k Then
      sRow = UBound(sArr, 2)
      ReDim Res(1 To sRow, 1 To sCol)
      For i = 1 To UBound(sArr, 2)
        For j = 1 To k
          Res(i, colArr(1, j)) = sArr(colArr(2, j), i)
        Next j
      Next
      tdRng(1, 1).Offset(1, 0).Resize(sRow, sCol) = Res
    Else
      MsgBox ("Khong tìm thay Cot du lieu phu hop")
    End If
  Else
    MsgBox ("Khong tìm thay File du lieu")
    On Error GoTo 0
  End If
  Set Dic = Nothing
End Sub

 

[ptm0412]

Bác nói chí phải, em sẽ nghe lời bác

Vẫn còn người rộng lượng và vẫn chiều

 

[tieuthubuongbinh]

Bác nói chí phải, em sẽ nghe lời bác

@ptm0412 huhu bác ức hiếp con quá nha nha haha

anh @HieuCD là nhất hihi
Mà anh ơi, sao nó không hiện ra data của cột E và F (em có điền tiêu đề sẵn rồi)?

 

[HieuCD]

@ptm0412 huhu bác ức hiếp con quá nha nha haha

anh @HieuCD là nhất hihi
Mà anh ơi, sao nó không hiện ra data của cột E và F (em có điền tiêu đề sẵn rồi)?

Gởi file và chọn vùng nào?