Import dữ liệu

Cá ngừ F1 · 18/10/13

E có 2 file excel (A và B), giả sử 2 file này đều nằm trong một folder
Sự kiện: đang mở file A, có marco nào có thể tự động copy dữ liệu sheet1 của B sang sheet1 của A (không phải thủ công: mở file B -> bôi đen -> ctrl C -> paste sang A)

nghiaphuc · 18/10/13

Cá ngừ F1 đã viết:
E có 2 file excel (A và B), giả sử 2 file này đều nằm trong một folder
Sự kiện: đang mở file A, có marco nào có thể tự động copy dữ liệu sheet1 của B sang sheet1 của A (không phải thủ công: mở file B -> bôi đen -> ctrl C -> paste sang A)

Không phải thủ công thì làm tự động bằng code vậy. Bạn tìm kiếm trên diễn đàn với từ khóa "tổng hợp dữ liệu từ nhiều file" sẽ có rất nhiều kết quả để tham khảo.

Cá ngừ F1 · 18/10/13

nghiaphuc đã viết:
Không phải thủ công thì làm tự động bằng code vậy. Bạn tìm kiếm trên diễn đàn với từ khóa "tổng hợp dữ liệu từ nhiều file" sẽ có rất nhiều kết quả để tham khảo.

Cảm ơn a..e sẽ nghiên cứu ạh..
p/s: nhiều khi ko biết từ khoá mà gõ ạh. Hì

Cá ngừ F1 · 20/10/13

nghiaphuc đã viết:
Không phải thủ công thì làm tự động bằng code vậy. Bạn tìm kiếm trên diễn đàn với từ khóa "tổng hợp dữ liệu từ nhiều file" sẽ có rất nhiều kết quả để tham khảo.

Hjk, nhiều topic quá.. đọc.. đọc .. mà như mò kim đáy bể ạh .. --=--

nghiaphuc · 20/10/13

Cá ngừ F1 đã viết:
Hjk, nhiều topic quá.. đọc.. đọc .. mà như mò kim đáy bể ạh ..

Demo một cái thế này vậy. Bạn mở file A, nhấn nút lệnh, chọn file nguồn, nếu chọn file nào thì dữ liệu trên Sheet1 của file ấy sẽ được chép vào Sheet1 của file A.
Code như sau:
[GPECODE=vb]Sub CopyTuFileKhac()
With Application.FileDialog(1)
.InitialFileName = ThisWorkbook.Path
.Title = "Chon file nguon"
.FilterIndex = 3
.AllowMultiSelect = False
Do
.Show
If .SelectedItems.Count = 0 Then Exit Sub
If .SelectedItems(1) = ThisWorkbook.FullName Then MsgBox "Khong chon file nay!"
Loop Until .SelectedItems(1) <> ThisWorkbook.FullName
With Workbooks.Open(.SelectedItems(1))
.Sheets(1).Cells.Copy ThisWorkbook.Sheets(1).[A1]
.Close False
End With
End With
End Sub[/GPECODE]

Cá ngừ F1 · 21/10/13

nghiaphuc đã viết:
Demo một cái thế này vậy. Bạn mở file A, nhấn nút lệnh, chọn file nguồn, nếu chọn file nào thì dữ liệu trên Sheet1 của file ấy sẽ được chép vào Sheet1 của file A.
Code như sau:
[GPECODE=vb]Sub CopyTuFileKhac()
With Application.FileDialog(1)
.InitialFileName = ThisWorkbook.Path
.Title = "Chon file nguon"
.FilterIndex = 3
.AllowMultiSelect = False
Do
.Show
If .SelectedItems.Count = 0 Then Exit Sub
If .SelectedItems(1) = ThisWorkbook.FullName Then MsgBox "Khong chon file nay!"
Loop Until .SelectedItems(1) <> ThisWorkbook.FullName
With Workbooks.Open(.SelectedItems(1))
.Sheets(1).Cells.Copy ThisWorkbook.Sheets(1).[A1]
.Close False
End With
End With
End Sub[/GPECODE]

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...

PhanTuHuong · 21/10/13

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

Cá ngừ F1 · 22/10/13

PhanTuHuong đã viết:
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

100 chẳng hạn
E cảm ơn ạh

PhanTuHuong · 22/10/13

Cá ngừ F1 đã viết:
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ụ: B2100 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

Cá ngừ F1 · 22/10/13

PhanTuHuong đã viết:
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...

PhanTuHuong · 22/10/13

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

Cá ngừ F1 · 22/10/13

PhanTuHuong đã viết:
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...

Cá ngừ F1 · 22/10/13

PhanTuHuong đã viết:
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

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??

PhanTuHuong · 22/10/13

Cá ngừ F1 đã viết:
Trong code có đoạn viết

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?

Cá ngừ F1 · 22/10/13

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

ndu96081631 · 22/10/13

PhanTuHuong đã viết:
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

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?

PhanTuHuong · 22/10/13

Cá ngừ F1 đã viết:
Đ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.

Cá ngừ F1 · 22/10/13

ndu96081631 đã viết:
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

ndu96081631 · 22/10/13

Cá ngừ F1 đã viết:
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:

Mã:

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

Mã:

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:\DuLieu\B.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:

Mã:

Sub Main()
  Dim FileName as String, SheetName as String, RangeAddress as String
  Dim arr
  [COLOR=#ff0000]FileName = "D:\DuLieu\B.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ụ:

Mã:

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é

Cá ngừ F1 · 22/10/13

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(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
MsgBox "Data has been successfully imported!"
End If
End If
End Sub

Quả thật, không biết nói gì hơn ạh @!##

Import dữ liệu

( ͡° ͜ʖ ͡°)

Thành viên gạo cội

( ͡° ͜ʖ ͡°)

( ͡° ͜ʖ ͡°)

Thành viên gạo cội

File đính kèm

( ͡° ͜ʖ ͡°)

VBA & VB.NET for Excel & AutoCad

File đính kèm

( ͡° ͜ʖ ͡°)

VBA & VB.NET for Excel & AutoCad

( ͡° ͜ʖ ͡°)

VBA & VB.NET for Excel & AutoCad

File đính kèm

( ͡° ͜ʖ ͡°)

( ͡° ͜ʖ ͡°)

VBA & VB.NET for Excel & AutoCad

( ͡° ͜ʖ ͡°)

Huyền thoại GPE

VBA & VB.NET for Excel & AutoCad

( ͡° ͜ʖ ͡°)

Huyền thoại GPE

( ͡° ͜ʖ ͡°)