Import dữ liệu

4 Responses

1. hands says:

   27/01/2023 at 9:32 am

   Nếu như chỉ copy 1 range từ B1 đến C10 của file B thì code thay đổi thế nào ạh?
   E cảm ơn nhiều…

   Em chạy thử xem thế nào, cần thì mình bổ sung và fix lại.

   Thầy có thể hướng dẫn thêm 2 nội dung được ko ạh:
   – cho phép chọn file nguồn (có thể ko cùng folder)
   – e chỉ muốn copy 1 mảng nào đó từ nguồn, ví dụ: B2:D100 chẳng hạn
   E cảm ơn ạh

   Có trường hợp nào file kết quả đang mở không để bẫy tình huống. Vì code kia chỉ thực hiện với file đóng

   Dạ.. file kết quả là 1 file do phần mềm của hệ thống tạo ra (cố định các trường rồi ạh). import lúc đóng thôi thầy ah…

   Em tải bản này, vùng chọn là tùy ý nhưng phải sửa code. Nên đọc code để hiểu cách thực hiện

   Code này e thấy rất dễ hiểu ạh (step by step)… e cảm ơn thầy…
   Trong code có đoạn viết

   'Chon vung nguôn du liêu dê copy (thay dôi tuy y muôn) With Sheet1
   .Range("B2:C50").Select
   Selection.Copy
   End With

   E có thay chỗ màu đỏ bằng sheet2 hoặc sheet3 thì code mất tác dụng ạh??

   File đó có Sheet2, Sheet3 đâu em?

   Sub DataCopy() Dim KetquachuoiFile As String
   Dim KetquaFile As Workbook
   Dim Thoat As Label

   'Bây lôi khi không chon file hoac chon không dung
   On Error GoTo Thoat

   Application.ScreenUpdating = False

   'Chon vung nguôn du liêu dê copy (thay dôi tuy y muôn)
   With Crystalviewer
   .Range("AS1:BC10000").Select
   Selection.Copy
   End With

   'Lay duong dan va mo file Ket qua
   KetquachuoiFile = Application.GetOpenFilename
   Set KetquaFile = Workbooks.Open(Filename:=KetquachuoiFile)

   'Dan kêt qua copy
   With KetquaFile
   .Sheets("P22").Activate
   'Chon ô dê paste
   .Range("A1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   .Close SaveChanges:=True
   End With

   Sheets("report").Select

   Application.CutCopyMode = xlNone
   Application.ScreenUpdating = True
   Set KetquaFile = Nothing
   Exit Sub

   Thoat:
   Application.CutCopyMode = xlNone
   End Sub

   Đoạn CODE như này có j sai ko thầy? khi mà e click ko có tác dụng
   E lấy mảng từ AS1:BC10000 1 sheets có tên Crystalviewer –> copy vào A1 sheet "P22"
   hjk

   Tên Sheet trên phải đặt trong dấu ngoặc kép chứ, mà phải chỉ rõ máy mới hiểu được. Nếu không lấy tên Sheet1 trong phần VBProject.

   Reply
2. hands says:

   27/01/2023 at 9:33 am

   Lúc đầu tôi thấy tác giả hỏi cách để LẤY DỮ LIỆU TỪ FILE ĐANG ĐÓNG VÀO FILE ĐANG MỞ (1)
   Còn code của thầy hình như làm ngược lạ: COPY DỮ LIỆU TỪ FILE ĐANG MỞ VÀO FILE ĐANG ĐÓNG (2)
   Hay tác giả thay đổi chủ ý?
   Tóm lại: Tác giả cần trường hợp nào? (1) hay (2) vậy?

   Dạ..trường hợp 1 ạh..vì import dữ liệu ạh..tức là có 1 nút lệnh copy ở 1 file đang mở lấy dữ liệu từ 1 file khác và copy vào 1 sheet nào đó từ file đang mở
   p/s: ôi..văn viết. Hjk

   Vậy thì dùng ADO mới là vô địch. Tặng bạn 2 code này:

   Function GetData(ByVal FileName As String, Optional ByVal SheetName As String = "", Optional ByVal RangeAddress As String = "")
   
   Dim cnn As Object, rsData As Object
     Dim tmpArr, arr
     Dim szConn As String, szSQL As String, tmp As String
     Dim lR As Long, lC As Long, lVersn As Long
     On Error GoTo ErrHandler
     lVersn = Val(Application.Version)
     Set cnn = CreateObject("ADODB.Connection")
     Set rsData = CreateObject("ADODB.Recordset")
   
   If lVersn < 12 Then
       szConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                   "Extended Properties=""Excel 8.0;HDR=No"";IMEX=1;"
     Else
       szConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                   "Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
     End If
     If SheetName = "" Then
       Dim Dbs  As Object, db As Object
       Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVersn < 12, "36", "120"))
       Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
       tmp = db.TableDefs(0).Name
       tmp = Replace(tmp, "''", "'")
       SheetName = tmp
       db.Close
       Set Dbs = Nothing: Set db = Nothing
     Else
       SheetName = SheetName & "$"
     End If
     cnn.Open szConn
     szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
     rsData.Open szSQL, cnn, 1, 1
     tmpArr = rsData.GetRows
     ReDim arr(UBound(tmpArr, 2), UBound(tmpArr, 1))
     rsData.Close: cnn.Close
     For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
       For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
         arr(lR, lC) = tmpArr(lC, lR)
       Next
     Next
     GetData = arr
     Set rsData = Nothing: Set cnn = Nothing
     Exit Function
   ErrHandler:
     MsgBox Err.Description
     Set rsData = Nothing: Set cnn = Nothing
   End Function

   Sub GetDataFromRS(ByVal Target As Range, ByVal FileName As String, Optional ByVal SheetName As String = "", Optional ByVal RangeAddress As String = "")
   
   Dim cnn As Object, rsData As Object
     Dim szConn As String, szSQL As String, tmp As String
     Dim lR As Long, lC As Long, lVersn As Long
     On Error GoTo ErrHandler
     lVersn = Val(Application.Version)
     Set cnn = CreateObject("ADODB.Connection")
     Set rsData = CreateObject("ADODB.Recordset")
   
   If lVersn < 12 Then
       szConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                   "Extended Properties=""Excel 8.0;HDR=No"";IMEX=1;"
     Else
       szConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                   "Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
     End If
   
   If SheetName = "" Then
       Dim Dbs  As Object, db As Object
       Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVersn < 12, "36", "120"))
       Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
       tmp = db.TableDefs(0).Name
       tmp = Replace(tmp, "''", "'")
       SheetName = tmp
       db.Close
       Set Dbs = Nothing: Set db = Nothing
     Else
       SheetName = SheetName & "$"
     End If
     cnn.Open szConn
     szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "]"
     'szSQL = "SELECT [F2],[F4] FROM [" & SheetName & RangeAddress & "] WHERE F1>5 AND F3 = 'ELECTRIC'"
     rsData.Open szSQL, cnn, 1, 1
     Target.CopyFromRecordset rsData
     rsData.Close: cnn.Close
     Set rsData = Nothing: Set cnn = Nothing
      MsgBox "Data has been successfully imported!"
     Exit Sub
   ErrHandler:
     MsgBox Err.Description
     Set rsData = Nothing: Set cnn = Nothing
   End Sub

   Tùy chọn xài 1 trong 2 cái nha!
   – Cả 2 cái đều có thể dùng trực tiếp trong VBA
   – Cái thứ nhất là HÀM, vậy bạn có thể gõ trực tiếp trên bảng tính
   – Cái thứ hai là SUB, vậy chỉ có thể dùng trong VBA (không gõ đươc trên bảng tính)
   ——————————-
   Phần code ở trên bạn cho vào 1 Module và cũng không cần hiểu, chỉ cần biết áp dụng là đủ
   Ví dụ: Bạn chọn áp dụng HÀM
   – File dữ liệu đang đóng nằm ở: "D:DuLieuB.xls"
   – Tên sheet của file dữ liệu là "Sheet3"
   – Vùng dữ liệu cần lấy là "C1:H10"
   – Vậy ta viết thêm code áp dụng thế này:

   Sub Main()
     Dim FileName as String, SheetName as String, RangeAddress as String
     Dim arr
     [COLOR=#ff0000]FileName = "D:DuLieuB.xls"
     SheetName = "Sheet3"
     RangeAddress = "C1:H10"[/COLOR]
     arr = GetData(FileName, SheetName, RangeAddress)
     If IsArray(arr) Then
       [COLOR=#0000cd]ThisWorkbook.Sheets(1).Range("A1")[/COLOR].Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
       MsgBox "Data has been successfully imported!"
     End If
   End Sub

   Chỉ cần lưu ý 3 dòng màu đỏ, khai báo cho đúng là được
   Chổ màu xanh chính là nơi bạn cần copy đến
   Lưu ý:
   – Nếu bạn chỉ khai báo FileName, không khai báo SheetName, RangeAddress thì đồng nghĩa bạn muốn lấy toàn bộ dữ liệu của sheet đầu tiên
   – Trong Sub Main (là Sub áp dụng), phần FileName bạn có thể dùng GetOpenFileName để tùy ý chọn file nguồn. Ví dụ:

   Sub Main_OpenFileName()
     Dim arr, vFile
     [COLOR=#ff0000]vFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm")[/COLOR]
     If TypeName(vFile) = "String" Then
       arr = GetData(CStr(vFile))
       If IsArray(arr) Then
         ThisWorkbook.Sheets(1).Range("A1").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
         MsgBox "Data has been successfully imported!"
       End If
     End If
   End Sub

   Màu đỏ dùng để mở hộp chọn file. Đoạn code trên không khai báo SheetName và RangeAddress nên code sẽ lấy toàn bộ dữ liệu ở sheet đầu tiên
   ——————

   Cách dùng cho code Sub GetDataFromRS cũng gần tương tự. Bạn tự khám phá nhé

   Reply
3. hands says:

   27/01/2023 at 9:37 am

   Cái Excel file này hình như ko chơi được với chú *.xlsb đúng ko ạh

   Sub Main_OpenFileName() Dim arr, vFile
   vFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm")

   Bạn cứ tự thêm kiểu file xlsb vào rồi thí nghiệm là biết liền chứ gì

   vFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm;[COLOR=#ff0000]*.xlsb[/COLOR]")

   Vẫn ngon lành cành đào ạh… file nguồn nhỏ… import còn nhanh hơn…

   Lúc đầu tôi thấy tác giả hỏi cách để LẤY DỮ LIỆU TỪ FILE ĐANG ĐÓNG VÀO FILE ĐANG MỞ (1)
   Còn code của thầy hình như làm ngược lạ: COPY DỮ LIỆU TỪ FILE ĐANG MỞ VÀO FILE ĐANG ĐÓNG (2)
   Hay tác giả thay đổi chủ ý?
   Tóm lại: Tác giả cần trường hợp nào? (1) hay (2) vậy?

   Hê hê, em đọc không kỹ! Đơn giản hơn thì mở ngầm như em đã làm.

   Sub Main_OpenFileName() Dim arr, vFile
   vFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm")
   SheetName = "Crystalviewer"
   RangeAddress = "AS1:BC10000"
   If TypeName(vFile) = "String" Then
   arr = GetData(vFile, SheetName, RangeAddress)
   If IsArray(arr) Then
   ThisWorkbook.Sheets("P22").Range("A1").Resize(UBou nd(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
   MsgBox "Data has been successfully imported!"
   End If
   End If
   End Sub

   Bác nên bẫy trường hợp không chọn file nữa.

   Đó đâu phải code của tôi
   Code tôi nằm ở bài 19 đấy
   Nói chung tôi không bao giờ bỏ qua công đoạn bẫy lỗi

   Ý em là có trường hợp mở file nhưng không thực hiện bằng cách bấm Cancel hay Esc, giá trị trả về False. Không hiểu đoạn code trên đã bẫy chưa?

   Thì vâng! Code ở bài 19 có bẫy lỗi vậy đấy: Nếu đóng cửa sổ OpenFile hoặc bấm Cancel thì nó sẽ không làm gì cả. Câu lệnh để bẫy lỗi là vầy

   vFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm;*.xlsb")
   [COLOR=#ff0000]If TypeName(vFile) = "String" Then [/COLOR]
     Làm công việc Import
   [COLOR=#ff0000]End If[/COLOR]

   Còn code mà thầy nói là người ta "chế" lại, bỏ mất đoạn bẫy lỗi đi rồi

   Hề hề, em không đọc kỹ, họ bẫy lỗi bằng TypeName.

   ——————————-

   E thấy có khác mấy đâu ạh -\/.

   Sẽ khác nếu như hộp OpenFile mở ra nhưng bạn lại không chọn file nào mà bấm nút Cancel
   Thử sẽ biết
   Theo nhận định của tôi: Viết code đã khó mà bẫy lỗi để lường trước mọi trường hợp trục trặc phát sinh lại càng khó gấp trăm lần

   E vừa thử, chưa thấy hiện tượng j, sheet P22 import vào vẫn y nguyên, ko bị xóa, mong thầy chỉ giáo

   Vẫn nên khuyên là em tự học đi, nếu còn gắn bó với Excel và VBA thì chịu khó nghiên cứu để phát triển. Code của bác ndu đưa ra thì là 1 sản phẩm nâng cao rồi, đọc không dễ hiểu.

   Em thử phát này xem sao.

   E cảm ơn 2 thầy ạh..code của các thầy e sẽ lưu trữ cẩn thận…

   Reply
4. hands says:

   27/01/2023 at 9:45 am

   Nâng cao hơn chút..e muốn import 2 sheets thì code thay đổi thế nào ạh (nếu làm 2 nút thì hơi CÙI ạh)

   Thì Import xong sheet này lại tiếp tục Import sheet khác! Chẳng phải trong hàm có đối số SheetName sao?

   Dạ, ý e là import cùng lúc sheet1, sheet2.. của file B về sheet1, sheet2.. của file A ah.
   Hiện tại, theo hướng dẫn của thầy e đang làm 2 nút import và khai báo thêm sub nữa ạh

   Gì mà 2 Sub chứ! Thế sao bạn không gôm 2 sub ấy làm một?
   Cho dù không biết nhưng ít ra điều bạn có thể làm là:
   – Viết code bình thường trên 1 Sub, Import 1 sheet
   – Viết tiếp 1 code nữa trên 1 Sub khác để import 1 Sheet khác
   – Kiểm tra, nếu thấy 2 sub này chạy ổn định thì điều đơn giản là gôm 2 Sub ấy thành 1 rồi chạy (sẽ tương đương với việc chạy 2 Sub cùng lúc)
   Thế thôi

   Chào Thầy ạ!

   Vậy thì dùng ADO mới là vô địch
   …
   Cách dùng cho code Sub GetDataFromRS cũng gần tương tự. Bạn tự khám phá nhé

   Bài này của Thầy hấp dẫn quá! hihi
   Khi nào Thầy ranh rảnh vì chưa có bài viết nào thì Thầy tạo giúp con nốt cái Main_2 cho Sub GetDataFromRS Thầy nhé!
   Hi, Cảm Thầy ạ!

   Gần giống mà. Ví dụ:

   Sub Main2()
     Dim Target as Range, FileName as String, SheetName as String, RangeAddress as String
     Set Target =  ThisWorkbook.Sheets(1).Range("A1")
     FileName = "D:DuLieuB.xls"
     SheetName = "Sheet3"
     RangeAddress = "C1:H10"
     [B]GetDataFromRS[/B] Target, FileName, SheetName, RangeAddress
     MsgBox "Data has been successfully imported!"
   End Sub

   Cái này chỉ chổ nó dữ liệu "đáp xuống" luôn (chính là biến Target)
   (thử xem, tôi viết đại, chưa test)
   —————-
   Các bạn cần nên đặt 1 câu hỏi: Khi nào thì nên dùng hàm GetData và khi nào thì nên dùng Sub GetDataFromRS? —> Thế mới hiểu sâu vấn đề

   Ôi, không chạy được Thầy ạ, Có lẽ con áp dụng không đúng cách.
   Thầy xem lại cách 3 giúp con với ạ.
   Còn câu hỏi của Thầy đặt ra đúng là rất hay. Chắc là cũng phải tùy từng trường hợp nào thì vận dụng cách này hoặc cách kia để thể hiện ưu điểm nó.
   Nhưng con chỉ biết áp dụng thôi, còn đọc code con chịu thua nên không chưa thể trả lời câu hỏi trên.
   Thầy chỉ giáo ạ!
   Cảm ơn Thầy!

   1> Thứ nhất: Sửa chổ này:

   Sub GetDataFromRS(ByVal Target As Range, ByVal FileName As String, Optional ByVal SheetName As String = "", Optional ByVal RangeAddress As String = "")
   
   Dim cnn As Object, rsData As [COLOR=#ff0000]ADODB.Recordset[/COLOR]
     ......
   End Sub

   thành vầy:

   Sub GetDataFromRS(ByVal Target As Range, ByVal FileName As  String, Optional ByVal SheetName As String = "", Optional ByVal  RangeAddress As String = "")
   
   Dim cnn As Object, rsData As [COLOR=#ff0000]Object[/COLOR]
     ......
   End Sub

   Chổ này là tôi sơ sót
   2> Thứ 2: Sub Main2 sửa thành:

   Sub Main2()
     Dim Target As Range, FileName As String, SheetName As String, RangeAddress As String
     Set Target = ThisWorkbook.Sheets(1).Range("B2")
   
   FileName = [COLOR=#ff0000]ThisWorkbook.Path & "Ket qua.xlsx"[/COLOR]  <--- Đường dẫn này là tùy ý bạn nhé
     SheetName = "Sheet1"
     RangeAddress = "B2:D100"
   
   GetDataFromRS Target, FileName, SheetName, RangeAddress
   End Sub

   Tôi nghĩ quan trọng là sửa kiểu biến trong Sub GetDataFromRS thôi
   ————————–

   Còn câu hỏi của Thầy đặt ra đúng là rất hay. Chắc là cũng phải tùy từng trường hợp nào thì vận dụng cách này hoặc cách kia để thể hiện ưu điểm nó.
   Nhưng con chỉ biết áp dụng thôi, còn đọc code con chịu thua nên không chưa thể trả lời câu hỏi trên.
   Thầy chỉ giáo ạ!
   Cảm ơn Thầy!

   Câu hỏi này cứ từ từ suy nghĩ. Trong quá trình làm việc có lúc sẽ nhận ra thôi

   Khả năng sự khác biệt là: một cái copy nguyên value.. còn 1 cái copy cả hàm số (nếu có)
   P/s: e đoán mò tí.. vì mới thử dùng cách đầu tiên ạh

   Thì cứ đoán đi
   Nhưng mà câu trả lời này.. trật lất
   Ẹc… Ẹc…

   Thật ra em k bít gì về VBA, nhưng e có viết công thức tính toán gồm 3 sheet: nguồn, tính toán, kết quả.
   Em đã thiết kế đều chạy tốt, nhưng phải copy thủ công đưa dữ liệu vào sheet nguồn.
   Có cách nào dữ liệu sheet nguồn được lấy từ 1 file khác được k ạ?
   Nhấn nút COPY nó hiện hộp thoại ra cho mình chọn file để lấy dữ liệu đó ạ.
   Các bác viết dùm em đoạn code cho nút COPY}}}}}
   Cảm ơn tất cả^^

   Bạn xem lại bài #19 của thầy NDU nhé…import từ sheet tương đối

   [COLOR=#000000]Sub Main_OpenFileName()[/COLOR]  Dim arr, vFile
     [COLOR=#ff0000]vFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm;*.xlsb")[/COLOR]
     [COLOR=#ff0000][/COLOR][SIZE=2][COLOR=#ff0000][B]SheetName ="*loan"[/B][/COLOR][/SIZE]
     If TypeName(vFile) = "String" Then
       arr = GetData(CStr(vFile))
       If IsArray(arr) Then
         ThisWorkbook.Sheets(1).Range("A1").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
         MsgBox "Data has been successfully imported!"
       End If
     End If [COLOR=#000000]End Sub[/COLOR]

   E có sử dụng code của thầy NDU để import dữ liệu
   Tại mục SheetName có khai báo *loan để lấy dữ liệu từ sheet có tên "xxx.loan.xxx" mà ko có được
   Làm thế nào để lấy tên tương đối của sheet… Anh/chị giúp e với ạh

   Reply