Xin chào cả nhà, mình có một vấn đề muốn hỏi: mình muốn copy dữ liệu từ file "Book1.xlsm" vào file database "File Nguon.xlsx",và mình đang thực hành bằng câu lệnh INSERT trong SQL. Và do có nhiều dòng cần copy nên mình sẽ viết code vòng lặp cho nó (bắt đầu từ dòng thứ 5). Tuy nhiên code chạy thành công được 1 dòng (dòng thứ 5), đến dòng thứ 6 (vòng lặp thứ 2) là bị lỗi và hiện lỗi thông báo như dưới đây, rất mong các bạn chỉ cho mình lỗi khắc phục. Mình xin cảm ơn (các bạn vui lòng xem code của mình bên dưới)
Và code của mình viết như sau:
Bạn đem dòng: ob.Open sConnect ra ngoài vòng lặp, ngay bên dưới Set ob....
Bạn không nên dùng vòng lặp cho trường hợp này, không hiệu quả khi cứ tương tác qua lại liên tục giữa code và Sheet.
Bạn ngâm cứu lấy nguyên range một lần rồi lưu vào file đích nhé. Copy nguyên range trong diễn đàn này có nhiều bài.
Bạn đem dòng: ob.Open sConnect ra ngoài vòng lặp, ngay bên dưới Set ob....
Bạn không nên dùng vòng lặp cho trường hợp này, không hiệu quả khi cứ tương tác qua lại liên tục giữa code và Sheet.
Bạn ngâm cứu lấy nguyên range một lần rồi lưu vào file đích nhé. Copy nguyên range trong diễn đàn này có nhiều bài.
Mình cảm ơn bạn, lấy ra khỏi vòng lặp là chạy ok. Mình chưa biết phương pháp kia của bạn và mình sẽ tìm hiểu thêm. Phương pháp của mình thì không cần mở file đích để paste vào, nên mình thấy hay. Có một vấn đề cho phương pháp này là table không tự mở rộng khi thêm dữ liệu (nếu gõ hoặc paste vào thì table tự mở rộng). Không biết có cách nào table tự mở rộng mà không cần mở file đích không
Mình cảm ơn bạn, lấy ra khỏi vòng lặp là chạy ok. Mình chưa biết phương pháp kia của bạn và mình sẽ tìm hiểu thêm. Phương pháp của mình thì không cần mở file đích để paste vào, nên mình thấy hay.
Phương pháp kia tôi nói cũng là dùng ADO thôi. ADO có một phương thức là UpdateBatch: Cập nhật nguyên bó record.
Cách làm là:
- Gán toàn bộ range dữ liệu của sheet vào Array.
- Mở ADO recordset của tabe đích theo phương thức để dùng được UpdateBatch: CursorLocation - adUseClient; adLockBatchOptimistic.
- Chạy vòng lặp trên Array để gán dữ liệu cho từng Field của ADO recordset vừa mở -> rst.UpdateBatch.
(vòng lặp trên Array sẽ nhanh hơn nhiều so với vòng lặp với Sheet)
Có một vấn đề cho phương pháp này là table không tự mở rộng khi thêm dữ liệu (nếu gõ hoặc paste vào thì table tự mở rộng). Không biết có cách nào table tự mở rộng mà không cần mở file đích không
Tôi có một cái hàm dùng để tự động mở rộng Table dựa trên phương thức Worksheet_Change. Nhưng để chạy phương thức này thì buộc sheet phải mở thì code mới chạy cập nhật Range. Khi dữ liệu được thêm (tự động) ở dòng kế tiếp của Table thì Table range tự động mở rộng xuống dưới.
Do đó nếu bạn cập nhật dữ liệu bằng ADO trên file đóng thì coi như thua. Tôi không nghĩ có code cập nhật range Table cho file đóng. Bạn nào biết cách thì chia sẻ để học hỏi nhé.
Một giải pháp khác là vẫn dùng ADO nhưng mở file đích ở chế độ "Ẩn" thì tôi nghĩ Ok (chưa test).
Hàm tự động mở rộng Table Range:
Mã:
Option Explicit
'# Tu dong mo rong Table range moi khi co them du lieu o dong ke tiep
'# strPass: Neu co dung protect sheet
Public Sub extTableRange(ByVal rngTarget As Range, sTableName As String, sSheetName As String, Optional strPass As String)
Dim lstObj As ListObject
Dim rngTable As Range
Dim rngOffsetTbl As Range
'If rngTarget.Cells.Count > 1 Then Exit Sub 'Nhieu cell thay doi -> khong xu ly
If rngTarget.Value = "" Then Exit Sub 'Khi xoa cell -> khong xu ly
On Error GoTo ReEnableEvents
Application.EnableEvents = False
'Gan Table cho doi tuong lstObj
Set lstObj = Sheets(sSheetName).ListObjects(sTableName)
Set rngTable = lstObj.Range 'Lay range cua Table gan cho bien
Set rngOffsetTbl = rngTable.Rows(rngTable.Rows.Count + 1) 'Lay dong ke ben duoi Table gan cho bien range
'Neu co thay doi ngay dong ben duoi table
If Not Intersect(rngTarget, rngOffsetTbl) Is Nothing Then
'Un protect sheet neu co Protect sheet
If Not IsMissing(strPass) Then
Sheets(sSheetName).Unprotect Password:=strPass
End If
With rngTable
'Resize rngTable
Set rngTable = .Resize(.Rows.Count + 1, .Columns.Count)
End With
lstObj.Resize rngTable 'Resize range cua Table theo range moi
lstObj.Range.Locked = True
If Not IsMissing(strPass) Then
Sheets(sSheetName).Protect Password:=strPass
End If
End If
ReEnableEvents:
If Err.Number <> 0 Then
MsgBox "Co loi phat sinh: " & Sheets(sSheetName).Name & " - Worksheet_Change"
End If
Application.EnableEvents = True
End Sub
Sử dụng trong Sheet:
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
extTableRange Target, "Table1", "DanhMucVT"
End Sub
Phương pháp kia tôi nói cũng là dùng ADO thôi. ADO có một phương thức là UpdateBatch: Cập nhật nguyên bó record.
Cách làm là:
- Gán toàn bộ range dữ liệu của sheet vào Array.
- Mở ADO recordset của tabe đích theo phương thức để dùng được UpdateBatch: CursorLocation - adUseClient; adLockBatchOptimistic.
- Chạy vòng lặp trên Array để gán dữ liệu cho từng Field của ADO recordset vừa mở -> rst.UpdateBatch.
(vòng lặp trên Array sẽ nhanh hơn nhiều so với vòng lặp với Sheet)
Bạn xem file đính kèm.
Thực tế thử nghiệm tôi mới phát hiện ra là Table sẽ tự mở rộng Range khi bạn chèn thêm dữ liệu (bằng code) ngay bên dưới nó, không cần thêm code gì nữa với điều kiện là FileNguon.xlsx phải được mở khi chạy code chèn thêm dữ liệu.
Do đó có một giải pháp là mở file nguồn chạy ngầm để chèn dòng dữ liệu xong đóng lại. Thực ra nếu sau này file nguồn bạn có dùng Protect sheet để bảo vệ dữ liệu, muốn dùng ADO thao tác dữ liệu thì cũng phải mở nó lên, Unprotect sheet khi đó code mới chạy không bị lỗi.
- Tôi có thêm code mở workbook chạy ngầm nhưng thấy nó bị nhấp nháy màn hình quá.
- Vùng dữ liệu nhập bạn đặt tên là "InputData", khi có sự thay đổi range lấy dữ liệu thì sửa range name -> khỏi phải sửa trong code.
Mã:
Sub AppendData()
InsertRecord "InputData"
End Sub
Sub InsertRecord(insertRngName As String)
Dim sFullPathDesFile As String
sFullPathDesFile = ThisWorkbook.Path & "\FileNguon.xlsx"
'# MO FILE NGUON CHAY NGAM (HIDDEN) --> chay se bi lag man hinh, khong can thi bo code nay
Dim wb As Workbook
Set wb = Workbooks.Open(sFullPathDesFile)
wb.Windows(1).Visible = False
'#------------------------------------------
Dim oConn As ADODB.Connection, rst As ADODB.Recordset
Dim sConnect As String, sSQL As String
Dim arrData As Variant
Dim rngName As String
Dim i As Integer, k As Integer
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & sFullPathDesFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No;"";" 'Co the bo ;IMEX=1
Set oConn = New ADODB.Connection
oConn.Open sConnect
Set rst = New ADODB.Recordset
With rst
.CursorLocation = adUseClient
.Open "SELECT F1,F2 FROM [BISMUTH_CON$]", oConn, adOpenKeyset, adLockBatchOptimistic
arrData = Sheet1.Range(insertRngName).Value2
For i = LBound(arrData) To UBound(arrData)
.AddNew
For k = 0 To .Fields.Count - 1
.Fields(k).Value = arrData(i, k + 1)
Next k
Next i
.UpdateBatch
End With
'# Tra lai hien trang cho file nguon - luu va dong
wb.Windows(1).Visible = True
wb.Windows(1).Close SaveChanges:=True
'#-------------------------------------------
rst.Close
oConn.Close
Set rst = Nothing
Set oConn = Nothing
Erase arrData
End Sub
Bạn xem file đính kèm.
Thực tế thử nghiệm tôi mới phát hiện ra là Table sẽ tự mở rộng Range khi bạn chèn thêm dữ liệu (bằng code) ngay bên dưới nó, không cần thêm code gì nữa với điều kiện là FileNguon.xlsx phải được mở khi chạy code chèn thêm dữ liệu.
Do đó có một giải pháp là mở file nguồn chạy ngầm để chèn dòng dữ liệu xong đóng lại. Thực ra nếu sau này file nguồn bạn có dùng Protect sheet để bảo vệ dữ liệu, muốn dùng ADO thao tác dữ liệu thì cũng phải mở nó lên, Unprotect sheet khi đó code mới chạy không bị lỗi.
- Tôi có thêm code mở workbook chạy ngầm nhưng thấy nó bị nhấp nháy màn hình quá.
- Vùng dữ liệu nhập bạn đặt tên là "InputData", khi có sự thay đổi range lấy dữ liệu thì sửa range name -> khỏi phải sửa trong code.
Mã:
Sub AppendData()
InsertRecord "InputData"
End Sub
Sub InsertRecord(insertRngName As String)
Dim sFullPathDesFile As String
sFullPathDesFile = ThisWorkbook.Path & "\FileNguon.xlsx"
'# MO FILE NGUON CHAY NGAM (HIDDEN) --> chay se bi lag man hinh, khong can thi bo code nay
Dim wb As Workbook
Set wb = Workbooks.Open(sFullPathDesFile)
wb.Windows(1).Visible = False
'#------------------------------------------
Dim oConn As ADODB.Connection, rst As ADODB.Recordset
Dim sConnect As String, sSQL As String
Dim arrData As Variant
Dim rngName As String
Dim i As Integer, k As Integer
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & sFullPathDesFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No;"";" 'Co the bo ;IMEX=1
Set oConn = New ADODB.Connection
oConn.Open sConnect
Set rst = New ADODB.Recordset
With rst
.CursorLocation = adUseClient
.Open "SELECT F1,F2 FROM [BISMUTH_CON$]", oConn, adOpenKeyset, adLockBatchOptimistic
arrData = Sheet1.Range(insertRngName).Value2
For i = LBound(arrData) To UBound(arrData)
.AddNew
For k = 0 To .Fields.Count - 1
.Fields(k).Value = arrData(i, k + 1)
Next k
Next i
.UpdateBatch
End With
'# Tra lai hien trang cho file nguon - luu va dong
wb.Windows(1).Visible = True
wb.Windows(1).Close SaveChanges:=True
'#-------------------------------------------
rst.Close
oConn.Close
Set rst = Nothing
Set oConn = Nothing
Erase arrData
End Sub
- Tôi có thêm code mở workbook chạy ngầm nhưng thấy nó bị nhấp nháy màn hình quá.
Như vậy mở workbook chạy ngầm để table tự mở rộng. Cái nhấp nháy màn hình có thể khắc phục bằng cách thêm 2 dòng code đầu và cuối của chỗ mở file đó ra (Application.ScreenUpdating = false và = true), như vậy sẽ không nháy màn hình nữa
Mã:
Application.ScreenUpdating = False
'# MO FILE NGUON CHAY NGAM (HIDDEN) --> chay se bi lag man hinh, khong can thi bo code nay
Dim wb As Workbook
Set wb = Workbooks.Open(sFullPathDesFile)
wb.Windows(1).Visible = False
Application.ScreenUpdating = True
- Vùng dữ liệu nhập bạn đặt tên là "InputData", khi có sự thay đổi range lấy dữ liệu thì sửa range name -> khỏi phải sửa trong code.
Vùng InputData sẽ tự động thay đổi bằng cách mình thêm một code như sau:
Nói chung, code của bạn hữu dụng quá, code trước của mình mà có 20 cột cần INSERT thì cần khai báo 20 biến thì rất phiền hà
Mình có một vấn nữa như sau, nếu bạn biết thì bạn chỉ cho mình cách để mình tìm tòi thêm
FileNguon.xlsm mình muốn update số liệu (chỉnh sửa số liệu) từ dữ liệu file NhapLieu.xlsm thì có làm được không? Nếu theo mình cần phải dùng câu lệnh truy vấn UPDATE trong SQL, nhưng không biết xử lý ra sao. Dưới đây là hình ảnh chi tiết
FileNguon.xlsm mình muốn update số liệu (chỉnh sửa số liệu) từ dữ liệu file NhapLieu.xlsm thì có làm được không? Nếu theo mình cần phải dùng câu lệnh truy vấn UPDATE trong SQL, nhưng không biết xử lý ra sao. Dưới đây là hình ảnh chi tiết và 2 file đính kèm
Tôi chỉ biết tương đối về Excel thôi nên có những cái cũng cơ bản lắm nhưng chưa biết.
Về việc UPDATE dữ liệu thì làm được nếu như cột [Batch Number] của bạn là cột Khoá chính không trùng.
Mà sao việc cập nhập dữ liệu không đồng bộ cùng một lúc mà lại tách rời ra nhập liệu vậy?
Tôi chỉ biết tương đối về Excel thôi nên có những cái cũng cơ bản lắm nhưng chưa biết.
Về việc UPDATE dữ liệu thì làm được nếu như cột [Batch Number] của bạn là cột Khoá chính không trùng.
Mà sao việc cập nhập dữ liệu không đồng bộ cùng một lúc mà lại tách rời ra nhập liệu vậy?
Sub updateRecord(insertRngName As String)
Dim sFullPathDesFile As String
sFullPathDesFile = ThisWorkbook.Path & "\FileNguon.xlsx"
Application.ScreenUpdating = False
Dim oConn As ADODB.Connection, rst As ADODB.Recordset
Dim sConnect As String, sSQL As String
Dim arrData As Variant
Dim i As Integer, k As Integer
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & sFullPathDesFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No;"";" 'Co the bo ;IMEX=1
Set oConn = New ADODB.Connection
oConn.Open sConnect
sSQL = "SELECT F1,F6,F7,F8,F9,F10,F11 FROM [BISMUTH_CON$] WHERE F7 is null"
Set rst = New ADODB.Recordset
With rst
.CursorLocation = adUseClient
.Open sSQL, oConn, adOpenKeyset, adLockOptimistic
arrData = Sheet1.Range(insertRngName).Value2
Do Until .EOF
For i = LBound(arrData) To UBound(arrData)
If .Fields(0).Value = arrData(i, 1) Then
For k = 1 To .Fields.Count - 1
If k >= 4 Then
.Fields(k).Value = CDbl(arrData(i, k + 5))
Else
.Fields(k).Value = arrData(i, k + 5) 'k+5=6 -> vi tri 6 trong mang
End If
Next k
.Update
Exit For
End If
Next i
rst.MoveNext
Loop
End With
MsgBox "Da cap nhat xong."
rst.Close
oConn.Close
Set rst = Nothing
Set oConn = Nothing
Erase arrData
End Sub
Sub updateRecord(insertRngName As String)
Dim sFullPathDesFile As String
sFullPathDesFile = ThisWorkbook.Path & "\FileNguon.xlsx"
Application.ScreenUpdating = False
Dim oConn As ADODB.Connection, rst As ADODB.Recordset
Dim sConnect As String, sSQL As String
Dim arrData As Variant
Dim i As Integer, k As Integer
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & sFullPathDesFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No;"";" 'Co the bo ;IMEX=1
Set oConn = New ADODB.Connection
oConn.Open sConnect
sSQL = "SELECT F1,F6,F7,F8,F9,F10,F11 FROM [BISMUTH_CON$] WHERE F7 is null"
Set rst = New ADODB.Recordset
With rst
.CursorLocation = adUseClient
.Open sSQL, oConn, adOpenKeyset, adLockOptimistic
arrData = Sheet1.Range(insertRngName).Value2
Do Until .EOF
For i = LBound(arrData) To UBound(arrData)
If .Fields(0).Value = arrData(i, 1) Then
For k = 1 To .Fields.Count - 1
If k >= 4 Then
.Fields(k).Value = CDbl(arrData(i, k + 5))
Else
.Fields(k).Value = arrData(i, k + 5) 'k+5=6 -> vi tri 6 trong mang
End If
Next k
.Update
Exit For
End If
Next i
rst.MoveNext
Loop
End With
MsgBox "Da cap nhat xong."
rst.Close
oConn.Close
Set rst = Nothing
Set oConn = Nothing
Erase arrData
End Sub
Tôi chỉ biết tương đối về Excel thôi nên có những cái cũng cơ bản lắm nhưng chưa biết.
