Sử dụng ADO để copy dữ liệu từ file này sang file khác (1 người xem)

  • Thread starter Thread starter USB1394
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
USB1394

USB1394

Thành viên hoạt động
Tham gia
20/12/08
Bài viết
173
Được thích
12
Nghề nghiệp
Lính triều đình
Mình có 2 file cùng nằm trong 1 thư mục : Nguon.xlsm và Dich.xlsm
Trong file: Nguon.xlsm . Ta có vùng dữ liệu cần cập nhật , gồm 242 cột (từ cột "AB" đến cột "JI") , bắt đầu từ dòng 35 đến dòng cuối cùng trong cột "AB"
File : Dich.xlsm cũng có cấu trúc tương tự . Mình xin code để thực hiện công việc :
Thứ 1 : "Cập nhật vùng dữ liệu từ file : Nguon.xlsm đến Dich.xlsm bằng ADO (chỉ phần dữ liệu , bỏ qua phần tiêu đề)"
Thứ 2 : Sau khi cập nhật xong , thì chạy 1 marco trên file: Dich.xlsm (để xác nhận nội dung đã được làm mới chẳn hạn)
Xin các bạn quan tâm giúp đỡ, xin cám ơn+-+-+-++-+-+-++-+-+-+
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Mong mọi người giúp đỡ !;;;;;;;;;;;
 
Upvote 0
Thì ra là vậy . Mình gởi file mẫu lên nhé
 

File đính kèm

Upvote 0
Mình gởi lại đây . Sự cố kỹ thuật
 

File đính kèm

Upvote 0
Bạn sử dụng Code sau
Mã: 
Option Explicit
Sub Update()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.Path & "\Nguon.xlsm"
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=No"";"
        .Open
    End With
    lsSQL = "Select * From [CSDL$AB35:IJ100000] Where f1 Is Not Null"
    lrs.Open lsSQL, cnn, 3, 1
    If Sheets("SP").[AB35] = "" Then
        Sheets("SP").Range("AB35").CopyFromRecordset lrs
    Else
        Sheets("SP").Range("AB35").End(xlDown).Offset(1, 0).CopyFromRecordset lrs
    End If
    MsgBox "Da Update CSDL", vbInformation
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub
 
Upvote 0
Mã: 
From [CSDL$AB35:IJ[COLOR=#ff0000]100000[/COLOR]]
Ở đây dòng , dòng cuối cùng không thể xác định là 100000 được vì tuỳ vào phát sinh trong khi sử dụng

Mã: 
MsgBox "Da Update CSDL", vbInformation
Ở đây là một thủ tục nằm trên file: Dich.xlsm để thực hiện thao tác tạo file: Dich.xlsm thành file: USM.xlam . Thủ tục này giúp ta thực hiện 1 công việc khác . Trong bài mình chỉnh minh hoạ là xuất thông báo thôi

Mã: 
[COLOR=#ff0000]If[/COLOR] Sheets("SP").[AB35] = "" Then         Sheets("SP").Range("AB35").CopyFromRecordset lrs     Else         Sheets("SP").Range("AB35").End(xlDown).Offset(1, 0).CopyFromRecordset lrs     End If

Ở đây mình , mình chỉ cập nhật giá trị trên file : Nguon.xlsm sang file: Dich.xlsm . Nên việc
xét Sheets("SP").[AB35] = "" là không cần thiết . Nguồn thay đổi sao thì Đích thay đổi thế
 
Upvote 0
Có vẻ như bạn biết ADO?
Mình sẽ không chỉnh sửa một dòng Code nào cả, chỉ nêu ra 1 số vấn đề bạn thắc mắc
1/
Mã: 
[COLOR=#000000]Ở đây dòng , dòng cuối cùng không thể xác định là 100000 được vì tuỳ vào phát sinh trong khi sử dụng
[/COLOR]

Bạn hiểu CSDL thì cấu trúc như thế nào?
Mã: 
lsSQL = "Select * From [CSDL$AB35:IJ100000] [COLOR=#ff0000]Where f1 Is Not Null[/COLOR][COLOR=#000000]
[/COLOR]

Đoạn màu đỏ có ý nghĩa gì?
2/
Mã: 
[COLOR=#000000]Ở đây là một thủ tục nằm trên file: Dich.xlsm để thực hiện thao tác tạo file: Dich.xlsm thành file: USM.xlam . Thủ tục này giúp ta thực hiện 1 công việc khác . Trong bài mình chỉnh minh hoạ là xuất thông báo thôi[/COLOR][COLOR=#000000]
[/COLOR]

Cái này nằm ngoài khả năng của mình vì mình không được đào tạo và cũng không tìm kiếm được thông tin phát sinh hay gì gì đó trong suy nghĩ của bạn.
3/
Mã: 
[COLOR=#000000]Ở đây mình , mình chỉ cập nhật giá trị trên file : Nguon.xlsm sang file: Dich.xlsm . Nên việc[/COLOR][COLOR=#000000]
[/COLOR][COLOR=#000000]xét [/COLOR][COLOR=#ff0000]Sheets("SP").[AB35] = ""[/COLOR][COLOR=#000000] là không cần thiết . Nguồn thay đổi sao thì Đích thay đổi thế
[/COLOR]

Bạn đưa ra yêu cầu là
Sử dụng ADO để copy dữ liệu từ file này sang file khác
Nhấp chuột vào đây để mở rộng...

Nên mình chỉ hiểu là bạn muốn Copy dữ liệu qua File khi chạy Macro không biết "thâm ý" phía sau của bạn là gì cả. Và để giải quyết "suy đoán riêng của mình" mình đã đưa ra giải pháp =>bạn hiểu và bạn có thể thay đổi phải không?

Cuối cùng: Chúc bạn tìm được giải pháp tốt nhất nhé!
Chào tạm biệt!
 
Upvote 0
Xin lỗi có lẽ Bạn hiểu lầm ý mình rồi . Mình chẳng hiểu gì về ADO cả mà chỉ biết chút ít về VBA thôi nên suy nghĩ của mình cũng dự trên VBA . Ví dụ đoạn :
Mã: 
[CSDL$AB35:IJ100000]
trong VBA mình hiểu : "Chỉ định 1 vùng Range("AB35:IJ100000") trong sheets("CSDL")
còn trong câu lệnh SQL :
Mã: 
lsSQL = "Select * From [CSDL$AB35:IJ100000] [COLOR=#ff0000]Where f1 Is Not Null[/COLOR]
thì có ý nghĩ khác , mà mình lại không biết . Nên mới gây ra hiểu lầm mong bạn thông cảm cho đừng để trong lòng

Còn phần : Thủ tục trên file: Dich.xlsm để thực hiện công việc khác . Nhưng do không liên quan đến nội dung chính (dùng ADO để copy dữ liệu) nên mình không đề cập để tránh làm rối vấn đề . Mình đợi sau khi giải quyết vấn đề chính xong , nếu mình không làm được thủ tục đó thì hỏi thêm như thế sẽ làm rõ từng vấn đề tiện giải quyết

Còn phần : tại sao mình đặt vấn đề là "Dùng ADO để copy dữ liệu" mà trong bài viết lại ghi "Cập nhật giá trị trên file" cài này cũng do mình không biết về ADO mà biết chút ít về VBA . Ví dụ :
Mã: 
If Sheets("SP").[AB35] = "" Then      Sheets("SP").Range("AB35").CopyFromRecordset lrs Else     Sheets("SP").Range("AB35").End(xlDown).Offset(1, 0).CopyFromRecordset lrs End If
Nếu trong VBA mình hiểu là cần xét đk range("AB35") có rỗng không để thi hành dòng lệnh , mà vấn đề của mình là copy nên không không cần xét .

Nói tóm lại , do mình không hiểu code trong ADO nên ghi ra hiểu lầm , mình xin đính chính lại . Nếu không rõ mình có thể nói thêm , mong bạn hiểu và thông cảm . Cám ơn sự quan tâm và giúp đỡ của bạn , mong sớm nhận được sự quan tâm của bạn , xin cám ơn +-+-+-++-+-+-++-+-+-+
 
Upvote 0
dhn46 đã viết:
Bạn sử dụng Code sau
Mã: 
Option Explicit
Sub Update()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.Path & "\Nguon.xlsm"
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=No"";"
        .Open
    End With
    lsSQL = "Select * From [CSDL$AB35:IJ100000] Where f1 Is Not Null"
    lrs.Open lsSQL, cnn, 3, 1
    If Sheets("SP").[AB35] = "" Then
        Sheets("SP").Range("AB35").CopyFromRecordset lrs
    Else
        Sheets("SP").Range("AB35").End(xlDown).Offset(1, 0).CopyFromRecordset lrs
    End If
    MsgBox "Da Update CSDL", vbInformation
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub
Nhấp chuột vào đây để mở rộng...

Khi chạy xuất hiện thông báo lỗi , bạn xem dùm nhé 1
 

File đính kèm

  • loi.jpg
    loi.jpg
    39.8 KB · Đọc: 185
Upvote 0
Hai Lúa Miền Tây đã viết:
Chỉ tham chiếu đến 65536 dòng thôi bạn.
Nhấp chuột vào đây để mở rộng...

Anh HLMT em đã Test trên Office 2007 không xảy ra bất kỳ lỗi gì, Office 2007 có số dòng > 65536 thì việc đặt 100000 dòng có thể gây lỗi không anh? Dữ liệu biến đổi, Version Office thay đổi, Convert Ex 2007 => 2003 ..v.v.. không thể lường được anh ah.
 
Upvote 0
dhn46 đã viết:
Anh HLMT em đã Test trên Office 2007 không xảy ra bất kỳ lỗi gì, Office 2007 có số dòng > 65536 thì việc đặt 100000 dòng có thể gây lỗi không anh? Dữ liệu biến đổi, Version Office thay đổi, Convert Ex 2007 => 2003 ..v.v.. không thể lường được anh ah.
Nhấp chuột vào đây để mở rộng...

Vấn đề này mình đã test trên 2010 và 2013 thì đúng là không thể tham chiếu vùng vượt qua con số 65.536 dòng. Trên 2007 mình trước giờ không xài nên không test được.
 
Upvote 0
hungpecc1 đã viết:
Thử sửa như vậy xem :

PHP: 
Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\myFolder\myExcel2007file.xlsm;
Extended Properties="Excel 12.0 Macro;HDR=YES";
Nhấp chuột vào đây để mở rộng...
Nếu sửa lại giống hệt thì code không chạy được cũng không có thông báo lỗi . Còn nếu sửa nội dung của bạn dhn46 thành nội dung của ban hungpecc1 tức là phần màu đỏ phải đặt trong dấu nháy kép màu xanh (thế này : " "Excel 12.0 Macro;HDR=YES" " ) thì cũng hiện hộp thoại báo lỗi như thế . Mình đang dùng MSE 2010
 
Upvote 0
hungpecc1 đã viết:
Thử sửa như vậy xem :

PHP: 
Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\myFolder\myExcel2007file.xlsm;
Extended Properties="Excel 12.0 Macro;HDR=YES";
Nhấp chuột vào đây để mở rộng...

Mình test thì lại báo lỗi như thế này.

Loi.PNG
Mình gửi cả file lên. Bác nào sửa giúp mình với.
 

File đính kèm

Upvote 0
Mong mọi người giúp đỡ
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Chuyển dữ liệu sang lưu trữ tại 1 bảng của Access, ưu điểm là dể truy vấn, dung lượng lưu trữ nhiều...
Nhấp chuột vào đây để mở rộng...
Chưa hiểu ý của Bạn . Chỉ chuyển dữ liệu (cụ thể là sheet "CSDL") hay là chuyển cả ý tưởng (thay vì dùng Excel để quản lý thì ta nên dùng Access) . Không biết ý bạn là thế nào , có thể nói rõ hơn không?
 
Upvote 0
Chuyển sheet CSDL vào 1 bảng của Access, sau đó cần cái gì thì ở Excel mình kết nối với bảng đó là được.
 
Upvote 0
Thử viết thành 1 hàm dạng tổng quát xem:
Mã: 
Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
            
  Dim rsCon As Object, rsData As Object, cat As Object, tbl As Object
  Dim tmpArr, arr()
  Dim szConnect As String, szSQL As String, tmp As String
  Dim lCount As Long, lR As Long, lC As Long, lVer As Long
  lVer = Val(Application.Version)
  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  Set cat = CreateObject("ADOX.Catalog")
  
  If lVer < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  End If
  If SheetName = "" Then
    Dim Dbs  As Object, db As Object
    Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVer < 12, "36", "120"))
    Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
    tmp = db.TableDefs(0).Name
    tmp = Replace(tmp, " ", "?")
    tmp = Replace(tmp, "'", " ")
    tmp = WorksheetFunction.Trim(tmp)
    tmp = Replace(tmp, " ", "'")
    tmp = Replace(tmp, "?", " ")
    SheetName = tmp
    db.Close
    Set Dbs = Nothing: Set db = Nothing
  End If
  If Right(SheetName, 1) <> "$" Then SheetName = SheetName & "$"
  rsCon.Open szConnect
  cat.ActiveConnection = rsCon
  
  szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
  rsData.Open szSQL, rsCon, 0, 1, 1
  tmpArr = rsData.GetRows
  ReDim arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1) + 1)
  If UseTitle Then
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(0, lC) = rsData.Fields(lC).Name
    Next
  End If
  For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(lR - UseTitle, lC) = tmpArr(lC, lR)
    Next
  Next
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  GetData = arr
End Function
---------------------
Code ở trên ta chẳng cần quan tâm, chỉ cần biết áp dụng là được (truyền tham số vào)
Cú pháp
Mã: 
GetData(Đuòng dẫn đến file nguồn, Tên Sheet, Vùng dữ liệu, Dữ liệu có tiêu đề không?, Có muốn lấy tiêu đề không?)
Ví dụ:
Mã: 
Sub Main()
  Dim arr
  On Error Resume Next
  arr = GetData(ThisWorkbook.Path & "\Nguon.xlsm", "CSDL", "AB35:IJ100000", False, False)
  If IsArray(arr) Then Range("AB35").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Nó báo vàng chổ rsCon.Open szConnect
 
Upvote 0
Mã: 
Sub Main()   Dim arr   On Error Resume Next   arr = GetData(ThisWorkbook.Path & "\Nguon.xlsm", "CSDL", "AB35:IJ100000", False, False)   If IsArray(arr) Then Range("AB35").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr End Sub
Thủ tục này đặt ở file nào vậy Bạn (Nguon.xlsm hay Dich.xlsm) ? Không thấy đề cập đến file: Dich.xlsm
 
Upvote 0
ndu96081631 đã viết:
Toàn bộ code đặt trong Module của file Dich.xlsm
Nhấp chuột vào đây để mở rộng...
Vấn đề của mình : Không mở file: Dich.xlsm . Mọi công việc làm trên file : Nguon.xlsm sau đó chạy code để copy dữ liêu sang file Dich.xlsm mà không cần mở file : Dich.xlsm . Bạn có cách nào sửa code lại không ? xin cám ơn !
 
Upvote 0
Code của Bác Ndu mình chạy trên Portable Offic 2007 thấy "ngọt" quá.
Bây giờ lại thêm 1 yêu cầu: Không mở file lên mà vẫn ghi dữ liệu vào.
Mình chỉ theo dõi chứ cái zụ này không rành.
 
Upvote 0
USB1394 đã viết:
Vấn đề của mình : Không mở file: Dich.xlsm . Mọi công việc làm trên file : Nguon.xlsm sau đó chạy code để copy dữ liêu sang file Dich.xlsm mà không cần mở file : Dich.xlsm . Bạn có cách nào sửa code lại không ? xin cám ơn !
Nhấp chuột vào đây để mở rộng...

Vậy bài toán của bạn là: GHI DỮ LIỆU VÀO FILE ĐANG ĐÓNG (chứ hổng phải lấy dữ liệu từ file đang đóng)
Nói chung là: TÔI KHÔNG BIẾT (Dù biết có loại code dạng này nhưng chả có nhu cầu gì nên cũng cóc thèm nghiên cứu)
 
Upvote 0
ndu96081631 đã viết:
Thử viết thành 1 hàm dạng tổng quát xem:
]
Nhấp chuột vào đây để mở rộng...
Giả sử em có dữ liệu cột A1:A100000
Gõ hàm :
PHP: 
 Arr = getData(thisworkbook.fullname,"sheet1","A1:A100000",false,false)
Em test thấy hàm getData của anh cũng chỉ lấy được dữ liệu từ 1: 65536 dòng thôi, nếu vượt hơn số này thì code sẽ báo lỗi như anh HLMT đã đề cập! <--- cũng không rõ tại sao !
 
Upvote 0
ndu96081631 đã viết:
Vậy bài toán của bạn là: GHI DỮ LIỆU VÀO FILE ĐANG ĐÓNG (chứ hổng phải lấy dữ liệu từ file đang đóng)
Nói chung là: TÔI KHÔNG BIẾT (Dù biết có loại code dạng này nhưng chả có nhu cầu gì nên cũng cóc thèm nghiên cứu)
Nhấp chuột vào đây để mở rộng...

Sao cóc nhảy laoxao thế này,
nghiên cứu đi a ndu...ơi,

hiihiiiiiiiiiii

mà tác giả cũng lạ tại sao phải ghi file đóng cho phức tạp, rùi sau đó kiểu gì chả mở lên xem được chưa, vậy nên mở ra ghi rùi đóng lại, người dùng cũng đâu mắt nhìn thấy đóng hay mở
???????
 
Upvote 0
ndu96081631 đã viết:
Vậy bài toán của bạn là: GHI DỮ LIỆU VÀO FILE ĐANG ĐÓNG (chứ hổng phải lấy dữ liệu từ file đang đóng)
Nói chung là: TÔI KHÔNG BIẾT (Dù biết có loại code dạng này nhưng chả có nhu cầu gì nên cũng cóc thèm nghiên cứu)
Nhấp chuột vào đây để mở rộng...

Trước tiên , xin cám ơn Bạn đã quan tâm và giúp đỡ . Nếu như đề tài mình ghi không rõ ràng mà làm Bạn tốn nhiều thời gian quý báo vào đó thì mình thật sự xin lỗi , do cách diễn giải vấn đề mỗi người mỗi khác mong Bạn thông cảm đừng để trong lòng

Nhân đây mình cũng xin nói thêm : việc "GHI DỮ LIỆU VÀO FILE ĐANG ĐÓNG" cũng có giá trị thực tiễn của nó . Thực tế file: Nguon.xlsm là 1 file gốc giúp ta quản lý 1 CSDL các mặt hàng (gồm các tiêu chí : Mã - Tên hàng - Giá - và các thông tin khác) với các chức năng : Tạo - Xoá - Cập nhật - Lưu - Các chức năng khác

Khi file : Nguon.xlsm thay đổi thì code sẽ thực hiện 2 tác vụ chính
Thứ 1 : Copy dữ liệu từ file: Nguon.xlsm sang file: Dich.xlsm để cập nhật
Thứ 2 : Chạy code (trên file: Dich.xlsm) để Save as file này từ Dich.xlsm thành file : USM.xlam (Add in)
Car 2 tác vụ đó nhằm mục đích cập nhật sự thay đổi file : USM.xlam theo sự thay đổi của file : Nguon.xlsm

Từ file: USM.xlam ta có thể xây dựng các ứng dụng nhỏ (nhằm mục đích chia nhỏ file: Nguon.xlsm và tăng tốc mở file để chạy ứng dụng) từ việc khác thác Mã trong file Add in . Ví dụ : Bán hàng , Mua hàng, Thống kê hàng , Tìm kiếm thông tin hàng hoá , v.v. .

Nhưng do có nhiều vấn đề liên quan và không tiện hỏi cùng lúc , nên mình mới chia nhỏ vấn đề ra cho đơn giản thế mà lại gây hiểu lầm . Mình xin các bạn thông cảm , đừng để trong lòng , xin mọi người hãy quan tâm giúp đỡ . Xin cám ơn !+-+-+-++-+-+-++-+-+-+
 
Upvote 0
ndu96081631 đã viết:
Thử viết thành 1 hàm dạng tổng quát xem:
Mã: 
Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
            
  Dim rsCon As Object, rsData As Object, cat As Object, tbl As Object
  Dim tmpArr, arr()
  Dim szConnect As String, szSQL As String, tmp As String
  Dim lCount As Long, lR As Long, lC As Long, lVer As Long
  lVer = Val(Application.Version)
  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  Set cat = CreateObject("ADOX.Catalog")
  
  If lVer < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  End If
  If SheetName = "" Then
    Dim Dbs  As Object, db As Object
    Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVer < 12, "36", "120"))
    Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
    tmp = db.TableDefs(0).Name
    tmp = Replace(tmp, " ", "?")
    tmp = Replace(tmp, "'", " ")
    tmp = WorksheetFunction.Trim(tmp)
    tmp = Replace(tmp, " ", "'")
    tmp = Replace(tmp, "?", " ")
    SheetName = tmp
    db.Close
    Set Dbs = Nothing: Set db = Nothing
  End If
  If Right(SheetName, 1) <> "$" Then SheetName = SheetName & "$"
  rsCon.Open szConnect
  cat.ActiveConnection = rsCon
  
  szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
  rsData.Open szSQL, rsCon, 0, 1, 1
  tmpArr = rsData.GetRows
  ReDim arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1) + 1)
  If UseTitle Then
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(0, lC) = rsData.Fields(lC).Name
    Next
  End If
  For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(lR - UseTitle, lC) = tmpArr(lC, lR)
    Next
  Next
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  GetData = arr
End Function
---------------------
Code ở trên ta chẳng cần quan tâm, chỉ cần biết áp dụng là được (truyền tham số vào)
Cú pháp
Mã: 
GetData(Đuòng dẫn đến file nguồn, Tên Sheet, Vùng dữ liệu, Dữ liệu có tiêu đề không?, Có muốn lấy tiêu đề không?)
Ví dụ:
Mã: 
Sub Main()
  Dim arr
  On Error Resume Next
  arr = GetData(ThisWorkbook.Path & "\Nguon.xlsm", "CSDL", "AB35:IJ100000", False, False)
  If IsArray(arr) Then Range("AB35").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
End Sub
Nhấp chuột vào đây để mở rộng...


Hi Anh ndu96081631!

Có cách nào để chuyển dữ liệu từ 1 file Nguon trên Máy 1 sang file Dich trên Máy 2 trong mạng LAN, và file Dich có thể được mở hay đóng không ạ?

Regards
 
Upvote 0
hungpecc1 đã viết:
Giả sử em có dữ liệu cột A1:A100000
Gõ hàm :
PHP: 
 Arr = getData(thisworkbook.fullname,"sheet1","A1:A100000",false,false)
Em test thấy hàm getData của anh cũng chỉ lấy được dữ liệu từ 1: 65536 dòng thôi, nếu vượt hơn số này thì code sẽ báo lỗi như anh HLMT đã đề cập! <--- cũng không rõ tại sao !
Nhấp chuột vào đây để mở rộng...

Định sửa đoạn này:
Mã: 
szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
Thành:
Mã: 
szSQL = "SELECT * FROM [" & SheetName & "][" & RangeAddress & "];"
Nhưng thấy cũng chưa ổn (hết lỗi nhưng kết quả không chính xác)
Để suy nghĩ thêm xem
=================================================
USB1394 đã viết:
Trước tiên , xin cám ơn Bạn đã quan tâm và giúp đỡ . Nếu như đề tài mình ghi không rõ ràng mà làm Bạn tốn nhiều thời gian quý báo vào đó thì mình thật sự xin lỗi , do cách diễn giải vấn đề mỗi người mỗi khác mong Bạn thông cảm đừng để trong lòng
Nhấp chuột vào đây để mở rộng...
Vâng! Thì tôi đâu có trách bạn gì đâu (bạn hiểu lầm thôi)
Bạn cũng biết rằng mấy cái vụ nghiên cứu lập trình này nó phải có "cảm hứng"... Chỉ vì tôi hổng có nhu cầu thực tế nên cũng hổng có cảm hứng để nghiên cứu ----> Tức là LỖI TỪ TÔI mà thôi
Ẹc... Ẹc...
 
Lần chỉnh sửa cuối:
Upvote 0
Vâng , Bạn nói rất đúng : "Lập trình là phải có cảm hứng" . Hy vọng là vấn đề của mình sẽ đem đến cảm hứng và niềm vui cho Bạn và mọi người
 
Upvote 0
USB1394 đã viết:
Nhân đây mình cũng xin nói thêm : việc "GHI DỮ LIỆU VÀO FILE ĐANG ĐÓNG" cũng có giá trị thực tiễn của nó . Thực tế file: Nguon.xlsm là 1 file gốc giúp ta quản lý 1 CSDL các mặt hàng (gồm các tiêu chí : Mã - Tên hàng - Giá - và các thông tin khác) với các chức năng : Tạo - Xoá - Cập nhật - Lưu - Các chức năng khác
Nhấp chuột vào đây để mở rộng...

vấn đề này là khác ah,

Code trên của Dhn46 (trích dưới đây) cũng phải đặt trong file dich.xlms==> phải mở file này lên thì code đó mới chạy (sửa lại 100000 thành 65000 )

Còn nếu đặt ở nguon.xlms như bạn mong muốn thì chắc chắn là không chạy được rui


dhn46 đã viết:
Bạn sử dụng Code sau
Mã: 
Option Explicit
Sub Update()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.Path & "\Nguon.xlsm"
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=No"";"
        .Open
    End With
    lsSQL = "Select * From [CSDL$AB35:IJ65000] Where f1 Is Not Null"
    lrs.Open lsSQL, cnn, 3, 1
    If Sheets("SP").[AB35] = "" Then
        Sheets("SP").Range("AB35").CopyFromRecordset lrs
    Else
        Sheets("SP").Range("AB35").End(xlDown).Offset(1, 0).CopyFromRecordset lrs
    End If
    MsgBox "Da Update CSDL", vbInformation
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
vodoi2x đã viết:
Code trên của Dhn46 (trích dưới đây) cũng phải đặt trong file dich.xlms==> phải mở file này lên thì code đó mới chạy (sửa lại 100000 thành 65000 )
Nhấp chuột vào đây để mở rộng...
Em dùng Code trên chạy trên Portable Excel 2007 không lỗi gì (dữ liệu đủ 100000 dòng) nhưng quả thật chuyển qua Portable 2010 thì đơ luôn.
Anh Bill có nhiều phiên bản Office ngày càng cải tiến nhưng cái này có lẽ là "cải lùi" mất.
 
Upvote 0
dhn46 đã viết:
Em dùng Code trên chạy trên Portable Excel 2007 không lỗi gì (dữ liệu đủ 100000 dòng) nhưng quả thật chuyển qua Portable 2010 thì đơ luôn.
Anh Bill có nhiều phiên bản Office ngày càng cải tiến nhưng cái này có lẽ là "cải lùi" mất.
Nhấp chuột vào đây để mở rộng...


Đừng quan trọng vấn đề thế, Dữ liệu thực tế vài chục ngàn (thường là 10 000) dòng là nhiều rồi,

Ở đây người hỏi mong muốn "Ghi dữ liệu vào file đóng" thì là vấn đề khác.
 
Upvote 0
ndu96081631 đã viết:
Thử viết thành 1 hàm dạng tổng quát xem:
Mã: 
Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
            
  Dim rsCon As Object, rsData As Object, cat As Object, tbl As Object
  Dim tmpArr, arr()
  Dim szConnect As String, szSQL As String, tmp As String
  Dim lCount As Long, lR As Long, lC As Long, lVer As Long
  lVer = Val(Application.Version)
  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  Set cat = CreateObject("ADOX.Catalog")
  
  If lVer < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  End If
  If SheetName = "" Then
    Dim Dbs  As Object, db As Object
    Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVer < 12, "36", "120"))
    Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
    tmp = db.TableDefs(0).Name
    tmp = Replace(tmp, " ", "?")
    tmp = Replace(tmp, "'", " ")
    tmp = WorksheetFunction.Trim(tmp)
    tmp = Replace(tmp, " ", "'")
    tmp = Replace(tmp, "?", " ")
    SheetName = tmp
    db.Close
    Set Dbs = Nothing: Set db = Nothing
  End If
  If Right(SheetName, 1) <> "$" Then SheetName = SheetName & "$"
  rsCon.Open szConnect
  cat.ActiveConnection = rsCon
  
  szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
  rsData.Open szSQL, rsCon, 0, 1, 1
  tmpArr = rsData.GetRows
  ReDim arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1) + 1)
  If UseTitle Then
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(0, lC) = rsData.Fields(lC).Name
    Next
  End If
  For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(lR - UseTitle, lC) = tmpArr(lC, lR)
    Next
  Next
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  GetData = arr
End Function
---------------------
Code ở trên ta chẳng cần quan tâm, chỉ cần biết áp dụng là được (truyền tham số vào)
Cú pháp
Mã: 
GetData(Đuòng dẫn đến file nguồn, Tên Sheet, Vùng dữ liệu, Dữ liệu có tiêu đề không?, Có muốn lấy tiêu đề không?)
Ví dụ:
Mã: 
Sub Main()
  Dim arr
  On Error Resume Next
  arr = GetData(ThisWorkbook.Path & "\Nguon.xlsm", "CSDL", "AB35:IJ100000", False, False)
  If IsArray(arr) Then Range("AB35").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
End Sub
Nhấp chuột vào đây để mở rộng...

Bác Ndu ơi. Code của bác chạy rất tốt nếu file Nguon.xlsm không mở. Còn nếu file Nguon.xlsm mà mở thì nó không cho kết quả ở file dich.xlsm.
Bác sửa code giúp em để khi file Nguon.xlsm đang mở mà open file dich.xlsm nó chạy code cho kết quả như khi Nguon.xlsm đóng.
Cảm ơn bác Ndu và cảm ơn GPE.
 
Upvote 0
vẫn chưa thấy được mặt trời , chờ đợi và tiếp tục chờ đợi . . .
 
Upvote 0
ndu96081631 đã viết:
Định sửa đoạn này:
Mã: 
szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
Thành:
Mã: 
szSQL = "SELECT * FROM [" & SheetName & "][" & RangeAddress & "];"
Nhưng thấy cũng chưa ổn (hết lỗi nhưng kết quả không chính xác)
Để suy nghĩ thêm xem
=================================================
.
Nhấp chuột vào đây để mở rộng...

Em nghĩ được giải pháp này ! anh xem có ok không:
Ta sẽ dùng câu lệnh :
PHP: 
SELECT TOP
như vậy em sẽ viết là :
PHP: 
Lrows = Range(RangeAddress).Rows.Count
--> SzSQL = "SELECT TOP " & Lrows & " * FROM [" & SheetName & "$];"

Em test thử file của em thì ok, a test thử xem như thế nào !
 
Upvote 0
hungpecc1 đã viết:
Em nghĩ được giải pháp này ! anh xem có ok không:
Ta sẽ dùng câu lệnh :
PHP: 
SELECT TOP
như vậy em sẽ viết là :
PHP: 
Lrows = Range(RangeAddress).Rows.Count
--> SzSQL = "SELECT TOP " & Lrows & " * FROM [" & SheetName & "$];"

Em test thử file của em thì ok, a test thử xem như thế nào !
Nhấp chuột vào đây để mở rộng...

Vậy để xác định cái Lrows đó thì phải làm sao? Mở file rồi xác định?
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Vậy để xác định cái Lrows đó thì phải làm sao? Mở file rồi xác định?
Nhấp chuột vào đây để mở rộng...


*Lrows chỉ là 1 số thôi mà anh , giả sử "A1:A100000" thì ta xác định được ngay Lrows = 100000 mà --> Arr = .Getrows(Lrows,0) hoặc dùng SELECT TOP Lrows
* Cái khoai ở đây là : giải sử DataRange = "An:Am" ( với n <> 1) thì có lẽ lúc này ta phải dùng vòng lặp đưa toàn bộ dữ liệu vào mảng như kiểu :
PHP: 
For i = n to m
  rst.AbsolutePositon = i
< xử lý đưa vào mảng >
next
* Còn 1 cái khoai nữa : giả sử DataRange = "Xn:Ym" ( với X <> A) thì lúc này nếu ta viết [sheet1$X:Y] thì cũng chỉ lấy được 65536 dòng thôi ---> lúc này hổng có lẽ lại phải xác định X,Y là Fx ?,Fy? để đưa vào câu lệnh SELECT
===> Từ các * trên --> hàm getdata của anh Ndu là ok rồi người dùng nên cân nhắc đọc kỹ hướng dẫn sử dụng trước khi dùng !$@!!,( ^^ đến Advanced Filter cũng chỉ được đến 10^4dòng thôi mà )
 
Lần chỉnh sửa cuối:
Upvote 0
Đọc các bài viết thấy trên , dường như MSE KHÔNG CÓ KHẢ NĂNG lọc (advanced Filter) hoặc sao chép (copy) với số lượng dòng (record) lớn đến 1048576 dòng .

Như bạn hungpecc1 nói:
đến Advanced Filter cũng chỉ được đến 10^3 dòng thôi mà
Nhấp chuột vào đây để mở rộng...

Còn bạn ndu96081631 nói :
bạn có thể tạm dùng giải pháp: Mở file, copy dữ liệu, paste vào rồi đóng file và lưu
Nhấp chuột vào đây để mở rộng...
Cái này MSE nó báo lỗi , thậm chí mình cũng dùng thử cách của bạn hôm rồi : Copy vào mảng, dán giá trị từ mảng vào đích (với số dòng 1048576) cũng bị lỗi

Có phải mình lựa chọn MSE để quản lý CSDL là KHÔNG HỢP LÝ không ? Không biết các Bạn có ý kiến gì ? Mình nghĩ 1 CSDL cần có thể LỌC và SAO CHÉP được thì mới khai thác được ,không biết các Bạn có để đề xuất cho mình được giải pháp nào không ? Xin cám ơn
 
Upvote 0
Như bài 21 tôi đã đề cập, để lưu trữ dữ liệu với dung lượng lớn thì phải chọn cái khác chứ không phải excel, mà đó là Access hoặc SQL Server.
 
Lần chỉnh sửa cuối:
Upvote 0
USB1394 đã viết:
Đọc các bài viết thấy trên , dường như MSE KHÔNG CÓ KHẢ NĂNG lọc (advanced Filter) hoặc sao chép (copy) với số lượng dòng (record) lớn đến 1048576 dòng .

Như bạn hungpecc1 nói:
Nhấp chuột vào đây để mở rộng...
Mình nói nhầm bạn nhé Advanced Fillter khoảng 10^4 dòng bạn nhé, với số lượng lớn thì có thể dùng Remove Duplictae
bạn nên nhớ rằng Excel không phải là CSDL , excel chỉ là bảng tính --> Tùy trường hợp mà ta có thể áp dụng coi Excel là 1 CSDL,
Còn nếu bạn có 1 CSDL hoàn chỉnh thì như anh HLMT đã nói --> chuyển qua Accsess, nếu nhiều dữ liệu thì chia làm nhiều bảng , nhiều file trong access !
 
Upvote 0
Chức năng Filter của MSE có thể xử lý được đến cả dòng thứ 1048576 , vậy tai sao copy với số lượng dòng (record) 1048576 thì không thể được vậy anh Hai lúa miền tây ?
 

File đính kèm

  • 1.jpg
    1.jpg
    52.1 KB · Đọc: 9
  • 2.jpg
    2.jpg
    11.2 KB · Đọc: 7
Upvote 0
Với tôi dữ liệu lên đến 10.000 dòng là đã quá nhiều, tôi chưa từng có dữ liệu hết dòng trên excel 2007 và nếu có chăng đi nữa tôi cũng chọn giải pháp khác vì với số lượng dòng như thế này chắc gì máy cùi bấp như của tôi nó chạy nổi. Với yêu cầu của bạn tôi thật sự bó tay.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Như bài 21 tôi đã đề cập, để lưu trữ dữ liệu với dung lượng lớn thì phải chọn cái khác chứ không phải excel, mà đó là Access hoặc SQL Server.
Nhấp chuột vào đây để mở rộng...

Anh Hai lúa miền tây có thể nói sơ về ưu điểm và khuyết điểm giữa Access và SQL Server cho mình mở mang không ?
 
Upvote 0
1.) Về dung lượng:
- SQL Server bạn có thể tham khảo Tại đây
- Access chỉ được 2 gigabyte
2.) Về bảo mật:
- SQL Server có chính sách bảo mật hơn là Access.
3.) Kết nối dữ liệu từ xa qua Internet:
- SQL Server là ưu thế.
- Access: Có thể được nhưng phức tạp (Xin lỗi mình chưa thử dạng này)

Trên đây là những điểm nhận xét riêng của mình, dĩ nhiên sẽ còn có những điểm đáng lưu ý khác.
 
Upvote 0
ndu96081631 đã viết:
Trong khi chờ đợi, bạn có thể tạm dùng giải pháp: Mở file, copy dữ liệu, paste vào rồi đóng file và lưu
Tôi nghĩ thế cũng đâu có vấn đề gì
Nhấp chuột vào đây để mở rộng...

Bạn có thể giúp mình xây đựng 1 hàm truyền tham số:
1. File: Nguon.xlsm đang mở, file: Dich.xlsm đang đóng
2. Hàm có tác dụng
- Copy 1 vùng trong Nguon.xlsm tại sheet: "CSDL"
- Dán lấy giá trị vào Dich.xlsm tại sheet : "SP"
Mình sẽ kết hợp hàm này với vòng lặp FOR (xác định số lần copy dựa trên vị trí dòng cuối cùng của cột "AB" và số dòng tối đa mà hàm có thể sao chép đc = việc xác định này ta dùng hàm INT , IFF và MOD) như thế sẽ khắc phục được lỗi copy với số luợng dòng (record) quá lớn mà MSE ko thể làm đc . Bạn thấy sao !
 
Upvote 0
ndu96081631 đã viết:
Thử viết thành 1 hàm dạng tổng quát xem:
Mã: 
Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
            
  Dim rsCon As Object, rsData As Object, cat As Object, tbl As Object
  Dim tmpArr, arr()
  Dim szConnect As String, szSQL As String, tmp As String
  Dim lCount As Long, lR As Long, lC As Long, lVer As Long
  lVer = Val(Application.Version)
  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  Set cat = CreateObject("ADOX.Catalog")
  
  If lVer < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  End If
  If SheetName = "" Then
    Dim Dbs  As Object, db As Object
    Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVer < 12, "36", "120"))
    Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
    tmp = db.TableDefs(0).Name
    tmp = Replace(tmp, " ", "?")
    tmp = Replace(tmp, "'", " ")
    tmp = WorksheetFunction.Trim(tmp)
    tmp = Replace(tmp, " ", "'")
    tmp = Replace(tmp, "?", " ")
    SheetName = tmp
    db.Close
    Set Dbs = Nothing: Set db = Nothing
  End If
  If Right(SheetName, 1) <> "$" Then SheetName = SheetName & "$"
  rsCon.Open szConnect
  cat.ActiveConnection = rsCon
  
  szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
  rsData.Open szSQL, rsCon, 0, 1, 1
  tmpArr = rsData.GetRows
  ReDim arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1) + 1)
  If UseTitle Then
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(0, lC) = rsData.Fields(lC).Name
    Next
  End If
  For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(lR - UseTitle, lC) = tmpArr(lC, lR)
    Next
  Next
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  GetData = arr
End Function
---------------------
Code ở trên ta chẳng cần quan tâm, chỉ cần biết áp dụng là được (truyền tham số vào)
Cú pháp
Mã: 
GetData(Đuòng dẫn đến file nguồn, Tên Sheet, Vùng dữ liệu, Dữ liệu có tiêu đề không?, Có muốn lấy tiêu đề không?)
Ví dụ:
Mã: 
Sub Main()
  Dim arr
  On Error Resume Next
  arr = GetData(ThisWorkbook.Path & "\Nguon.xlsm", "CSDL", "AB35:IJ100000", False, False)
  If IsArray(arr) Then Range("AB35").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
End Sub
Nhấp chuột vào đây để mở rộng...
Anh ơi, có cách nào để giữ nguyên định dạng dữ liệu ở các cột như định dạng ở file gốc không anh?
 
Upvote 0
ivi_vn đã viết:
Anh ơi, có cách nào để giữ nguyên định dạng dữ liệu ở các cột như định dạng ở file gốc không anh?
Nhấp chuột vào đây để mở rộng...

Để giữ định dạng thì chỉ có cách mở file, copy và paste thôi
Hoặc cũng có cách là sau khi lấy được dữ liệu, ta tự mình định dạng lại (bằng tay hoặc bằng code)
 
Upvote 0
ndu96081631 đã viết:
Để giữ định dạng thì chỉ có cách mở file, copy và paste thôi
Hoặc cũng có cách là sau khi lấy được dữ liệu, ta tự mình định dạng lại (bằng tay hoặc bằng code)
Nhấp chuột vào đây để mở rộng...
Vâng, nhưng khi định dạng bằng tay cột ngày tháng năm không được anh. Em có gửi file vào mail cho anh rồi, anh xem giúp em cột ngày đến hạn.
Có trường hợp khi file nguồn mở thì không gặp lỗi trên!
Với trường hợp dữ liệu lớn thì khi mở file copy và paste thì rất chậm...
Cảm ơn anh đã trả lời!
 
Lần chỉnh sửa cuối:
Upvote 0
dhn46 đã viết:
Bạn sử dụng Code sau
Mã: 
Option Explicit
Sub Update()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
[COLOR=#ff0000][SIZE=4][B](1)[/B][/SIZE][/COLOR]
    FileFullName = Application.ThisWorkbook.Path & "\Nguon.xlsm"
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=No"";"
        .Open
    End With
[COLOR=#ff0000][SIZE=4][B](2)[/B][/SIZE][/COLOR]
    lsSQL = "Select * From [[SIZE=3][COLOR=#ff0000][B]CSDL[/B][/COLOR][/SIZE]$AB35:IJ100000] Where f1 Is Not Null"
    lrs.Open lsSQL, cnn, 3, 1
    If Sheets("SP").[AB35] = "" Then
        Sheets("SP").Range("AB35").CopyFromRecordset lrs
    Else
        Sheets("SP").Range("AB35").End(xlDown).Offset(1, 0).CopyFromRecordset lrs
    End If
    MsgBox "Da Update CSDL", vbInformation
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub
Nhấp chuột vào đây để mở rộng...

Tôi muốn đọc dữ liệu từ nhiều file, mỗi file có số sheet khác nhau nhưng cấu trúc đều như nhau và đều bắt đầu từ ô A5.
Danh sách các file nằm trong A2 đến A10

Liệu có thể dùng (gặp mã lệnh không chính xác thì tôi mô tả bằng lời) và đặt vô vị trí (1)

For i = 2 to 10
FileFullName= cells(i,1)
for J = 1 to sheets.count

Các lệnh để kết nối dữ liệu, trong đó cần hiệu chỉnh tên sheet của dòng lệnh (2) (chỗ có CSDL )

Xin hỏi như thế có được không. Nếu được thì 3 câu lệnh trên đặt ở (1) có được không hay chỗ khác. Phải đặt các câu lệnh

Next J
Next I

ở chỗ nào.

Xin cảm ơn
 
Upvote 0
haonlh đã viết:
Tôi muốn đọc dữ liệu từ nhiều file, mỗi file có số sheet khác nhau nhưng cấu trúc đều như nhau và đều bắt đầu từ ô A5.
Danh sách các file nằm trong A2 đến A10

Liệu có thể dùng (gặp mã lệnh không chính xác thì tôi mô tả bằng lời) và đặt vô vị trí (1)

For i = 2 to 10
FileFullName= cells(i,1)
for J = 1 to sheets.count

Các lệnh để kết nối dữ liệu, trong đó cần hiệu chỉnh tên sheet của dòng lệnh (2) (chỗ có CSDL )

Xin hỏi như thế có được không. Nếu được thì 3 câu lệnh trên đặt ở (1) có được không hay chỗ khác. Phải đặt các câu lệnh

Next J
Next I

ở chỗ nào.

Xin cảm ơn
Nhấp chuột vào đây để mở rộng...

1./ Kết nối với file nguồn.
2./ Lấy danh sách sheet của file nguồn đó.
3./ Duyệt qua từng sheet. Lưu ý nên loại bỏ những bảng mà không phải là tên sheet (Name, filter...)
4./ Đọc dữ liệu của từng sheet.
 
Upvote 0
Cho em hỏi ADO có xử lý được trường hợp thế này ko?
em có 2 file DM và Goc. File DM là file nguồn, file Goc là file cần lấy dữ liệu từ file nguồn ( dữ liệu file DM có thể 2 hoặc 3 sheet). Ở sheet1 file gốc có 2 button, khi em nhấn button DM1776 thì dữ liệu ở sheet DM1776 của file Góc sẽ được copy và pas từ sheet DM1776 của file DM và tương tự nếu nhấn vào sheet DMXL file Goc thì dữ liệu cũng được copy và past từ sheet DMLD của file DM qua file Goc.
 

File đính kèm

Upvote 0
matran25251325 đã viết:
Cho em hỏi ADO có xử lý được trường hợp thế này ko?
em có 2 file DM và Goc. File DM là file nguồn, file Goc là file cần lấy dữ liệu từ file nguồn ( dữ liệu file DM có thể 2 hoặc 3 sheet). Ở sheet1 file gốc có 2 button, khi em nhấn button DM1776 thì dữ liệu ở sheet DM1776 của file Góc sẽ được copy và pas từ sheet DM1776 của file DM và tương tự nếu nhấn vào sheet DMXL file Goc thì dữ liệu cũng được copy và past từ sheet DMLD của file DM qua file Goc.
Nhấp chuột vào đây để mở rộng...
Trường hợp của bạ hoàn toàn có thể làm được, nhưng CSDL của bạn không thuộc dạng chuẩn nên khuyến cáo không nên dùng ADO. Bạn có thể thử với code sau để tham khảo
Mã: 
Option Explicit
Sub Update()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.Path & "\[B]DM.xls[/B]"
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                            & "Data Source=" & FileFullName _
                            & ";Extended Properties=""Excel 12.0;HDR=No"";"
        .Open
    End With
    lsSQL = "Select * From [[B]DMLD$A5:Q6536[/B]]"
    lrs.Open lsSQL, cnn, 3, 1
   [B] Sheet3.Range("A5")[/B].CopyFromRecordset lrs
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub
 
Upvote 0
dhn46 đã viết:
Trường hợp của bạ hoàn toàn có thể làm được, nhưng CSDL của bạn không thuộc dạng chuẩn nên khuyến cáo không nên dùng ADO. Bạn có thể thử với code sau để tham khảo
Mã: 
Option Explicit
Sub Update()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.Path & "\[B]DM.xls[/B]"
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                            & "Data Source=" & FileFullName _
                            & ";Extended Properties=""Excel 12.0;HDR=No"";"
        .Open
    End With
    lsSQL = "Select * From [[B]DMLD$A5:Q6536[/B]]"
    lrs.Open lsSQL, cnn, 3, 1
   [B] Sheet3.Range("A5")[/B].CopyFromRecordset lrs
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub
Nhấp chuột vào đây để mở rộng...
Có cái gì đó ko ổn. Em chạy thử code ko có hiện tượng gì ngoài thông báo: " Provider cannot be found. It may not be properly íntalled
 
Upvote 0
Hai Lúa Miền Tây đã viết:
1./ Kết nối với file nguồn.
2./ Lấy danh sách sheet của file nguồn đó.
3./ Duyệt qua từng sheet. Lưu ý nên loại bỏ những bảng mà không phải là tên sheet (Name, filter...)
4./ Đọc dữ liệu của từng sheet.
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh lúa.
Đang dịp bận quá, bữa sau gửi file đính kèm (tối thiểu 3 file, 2 file dữ liệu gốc, 1 file đích) nhờ anh và diễn đàn
 
Upvote 0
Mong các thầy có hướng giúp em bài 57, dữ liệu file chính nhiều quá nên mỗi lần mở file phải mất gần 1 phút. giờ chỉ có tách dữ liệu ra riêng và mỗi ghi dùng file thì cập nhập dữ liệu thì may ra mới giải quyết được.+-+-+-+
 
Upvote 0
matran25251325 đã viết:
Mong các thầy có hướng giúp em bài 57, dữ liệu file chính nhiều quá nên mỗi lần mở file phải mất gần 1 phút. giờ chỉ có tách dữ liệu ra riêng và mỗi ghi dùng file thì cập nhập dữ liệu thì may ra mới giải quyết được.+-+-+-+
Nhấp chuột vào đây để mở rộng...
Bạn chắc là dùng Excel 2003. Vậy bạn sửa lại 1 chút

Mã: 
Option Explicit
Sub Update()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.Path & "\DM.xls"
    With cnn
        If Val(Application.Version) < 12 Then
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
        End If
        .Open
    End With
    lsSQL = "Select * From [DMLD$A5:Q6536]"
    lrs.Open lsSQL, cnn, 3, 1
    Sheet3.Range("A5").CopyFromRecordset lrs
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub
 
Upvote 0
dhn46 đã viết:
Bạn chắc là dùng Excel 2003. Vậy bạn sửa lại 1 chút

Mã: 
Option Explicit
Sub Update()
    On Error GoTo Handle
    Dim cnn As Object, lsSQL As String, lrs As Object, FileFullName As String
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    FileFullName = Application.ThisWorkbook.Path & "\DM.xls"
    With cnn
        If Val(Application.Version) < 12 Then
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
        End If
        .Open
    End With
    lsSQL = "Select * From [DMLD$A5:Q6536]"
    lrs.Open lsSQL, cnn, 3, 1
    Sheet3.Range("A5").CopyFromRecordset lrs
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub
Nhấp chuột vào đây để mở rộng...
Update hơi lâu xíu nhưng thôi tạm ổn rồi. TK anh nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Thử viết thành 1 hàm dạng tổng quát xem:
Mã: 
Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
            
  Dim rsCon As Object, rsData As Object, cat As Object, tbl As Object
  Dim tmpArr, arr()
  Dim szConnect As String, szSQL As String, tmp As String
  Dim lCount As Long, lR As Long, lC As Long, lVer As Long
  lVer = Val(Application.Version)
  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  Set cat = CreateObject("ADOX.Catalog")
  
  If lVer < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  End If
  If SheetName = "" Then
    Dim Dbs  As Object, db As Object
    Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVer < 12, "36", "120"))
    Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
    tmp = db.TableDefs(0).Name
    tmp = Replace(tmp, " ", "?")
    tmp = Replace(tmp, "'", " ")
    tmp = WorksheetFunction.Trim(tmp)
    tmp = Replace(tmp, " ", "'")
    tmp = Replace(tmp, "?", " ")
    SheetName = tmp
    db.Close
    Set Dbs = Nothing: Set db = Nothing
  End If
  If Right(SheetName, 1) <> "$" Then SheetName = SheetName & "$"
  rsCon.Open szConnect
  cat.ActiveConnection = rsCon
  
  szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
  rsData.Open szSQL, rsCon, 0, 1, 1
  tmpArr = rsData.GetRows
  ReDim arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1) + 1)
  If UseTitle Then
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(0, lC) = rsData.Fields(lC).Name
    Next
  End If
  For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(lR - UseTitle, lC) = tmpArr(lC, lR)
    Next
  Next
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  GetData = arr
End Function
---------------------
Code ở trên ta chẳng cần quan tâm, chỉ cần biết áp dụng là được (truyền tham số vào)
Cú pháp
Mã: 
GetData(Đuòng dẫn đến file nguồn, Tên Sheet, Vùng dữ liệu, Dữ liệu có tiêu đề không?, Có muốn lấy tiêu đề không?)
Ví dụ:
Mã: 
Sub Main()
  Dim arr
  On Error Resume Next
  arr = GetData(ThisWorkbook.Path & "\Nguon.xlsm", "CSDL", "AB35:IJ100000", False, False)
  If IsArray(arr) Then Range("AB35").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
End Sub
Nhấp chuột vào đây để mở rộng...


Các anh ơi cho em hỏi, em chỉ muốn lấy dòng cuối cùng trong Range thì sửa thế nào ạ
 
Upvote 0
Các anh ơi giúp em với
 
Upvote 0
Hàm GetData trả về một mảng dữ liệu 2 chiều (dòng và cột). Muốn lấy dòng cuối cùng thì dùng UBound để xác định chỉ số dòng cuối cùng rồi lấy nó ra.

Không nên sửa cái gì cả vì nếu bạn có khả năng sửa thì đã không hỏi.

thắc mắc: ADO dùng để lấy dữ liệu hàng loạt. Chỉ lấy dòng cuối thì dùng nó làm gì?
 
Upvote 0
Em cần lấy một số thông tin rời rạc ở dòng cuối cùng của 1 file tổng đưa vào file chi tiết mà không biết cách lấy thế nào cả ạ
 
Upvote 0
quyenpv đã viết:
Em cần lấy một số thông tin rời rạc ở dòng cuối cùng của 1 file tổng đưa vào file chi tiết mà không biết cách lấy thế nào cả ạ
Nhấp chuột vào đây để mở rộng...

Bạn lập một tiêu đề như phần tô đậm ở trên. Và mở một câu hỏi khác ở mục "Lập trình với Excel" này. Sẽ có người giúp bạn. Nếu có file mẫu đăng lên thì sẽ nhận được câu trả lời sớm và chính xác hơn.

Thớt này bàn về ADO. Công cụ ActiveX chỉ giành cho những người đã có kinh nghiệm ít nhiều về VBA.
 
Upvote 0
VetMini đã viết:
Bạn lập một tiêu đề như phần tô đậm ở trên. Và mở một câu hỏi khác ở mục "Lập trình với Excel" này. Sẽ có người giúp bạn. Nếu có file mẫu đăng lên thì sẽ nhận được câu trả lời sớm và chính xác hơn.

Thớt này bàn về ADO. Công cụ ActiveX chỉ giành cho những người đã có kinh nghiệm ít nhiều về VBA.
Nhấp chuột vào đây để mở rộng...

Em đã có lập Topic ở đây http://www.giaiphapexcel.com/forum/...file-tổng-hợp-sang-file-chi-tiết-và-ngược-lại

Thực sự em rất cần thiết nhưng đi hỏi mãi không ai trả lời, ngồi search nát GPE rồi anh ạ
Mong các anh giúp đỡ
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

phuongnam366377
VbaTools – Bộ công cụ mở rộng cho VBA trong Excel (4 người xem)
Trả lời
7
Đọc
80
phuongnam366377
phuongnam366377
L
Nhờ giúp đỡ công thức tính công từ dữ liệu trích xuất ra từ File chấm công (3 người xem)
Trả lời
0
Đọc
15
lưu tuấn dũng
L
H
Excel không lọc được toàn bộ dữ liệu (4 người xem)
Trả lời
0
Đọc
17
Hongphong123
H
Tuanba1992
Lập trình Excel có thể dùng ngôn ngữ lập trình nào? (1 người xem)
Trả lời
6
Đọc
249
nguyendang95
N
H
Tổng hợp Công Nợ theo Công trình (2 người xem)
Trả lời
27
Đọc
380
HangktGTN
H
H
  • Đã khóa
Công Thức Tính Tổng Công Nợ Khách Hàng
Trả lời
1
Đọc
32
ptm0412
ptm0412
B
Mình có làm đoạn code VBA trong file access mà cứ báo lỗi nhờ mọi người hướng dẫn
Trả lời
8
Đọc
135
ptm0412
ptm0412
GPE-Trợ Lý
CHÀO MỪNG 80 NĂM QUỐC KHÁNH (2 người xem)
    • Thích
    • Yêu thích
Trả lời
0
Đọc
48
GPE-Trợ Lý
GPE-Trợ Lý
thanhss
Tự động lấy dữ liệu từ các sheet khác đưa vào sheet tổng hợp khi chọn Ngày hoặc tháng hoặc năm
Trả lời
21
Đọc
248
thanthanhan
thanthanhan
vuthaiha90
Lọc dữ liệu không trùng và trả kết quả về 1 dòng
Trả lời
7
Đọc
280
tranhungdao12a3
T
T
Nhờ anh chị xem giúp file bị lỗi gì mà chạy rất chậm/lag - File tính tiền nhà trọ (1 người xem)
Trả lời
10
Đọc
400
Thaik05
T
Nguyễn Duy Tuân
Hàm BS COMBINLIST Liệt kê các giá trị tổ hợp, chỉnh hợp, chỉnh hợp không lặp | Add-in A-Tools v10
    • Yêu thích
    • Thích
Trả lời
24
Đọc
2K
nguyendang95
N
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng
Trả lời
13
Đọc
2K
huhumalu
H
hongphuong1997
Nên sử dụng Chatgpt hay Copilot
    • Yêu thích
Trả lời
12
Đọc
378
phuongnam366377
phuongnam366377
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ !
Trả lời
5
Đọc
144
PhanTuHuong
PhanTuHuong
U
VB tính tổng số cell trong 1 hàng có cùng màu với 1 cell so sánh ở cột khác
Trả lời
5
Đọc
104
Hoàng Tuấn 868
H
T
VBA LẤY THÔNG TIN TRÊN TỜ KHAI NHẬP KHẨU
Trả lời
10
Đọc
672
binhminh1408
B
H
Giúp mình ghép nhiều file thành một file.
Trả lời
10
Đọc
476
hanhnguyen120221cuty
H
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
18
Đọc
1K
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ZaloExcel v2.96: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn (2 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
60
Đọc
20K
HeSanbi
HeSanbi
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom