Cập nhật theo lô - Batch update

[levanduyet]

Trong một số ứng dụng, việc khởi tạo và import dữ liệu bên ngoài vào sau khi bạn hoàn thành là một công việc không dễ dàng chút nào. Làm sao để kiểm tra việc cập nhật có thành công hay không? Nếu không thành công thì hủy bỏ tất cả...
Việc cập nhật theo lô sẽ giúp bạn điều này.
Xin giới thiệu một thủ tục để các bạn tham khảo:

Option Explicit

Const DBTable As String = "TB_Bom"
Const DBPath As String = "\\Sun-Server\Production\QuanLyKho.mdb"

Sub BatchUpdate()

    Dim iLastrow As Long, i As Long, j As Long
    Dim conn As ADODB.Connection
    Dim ADOrst As ADODB.Recordset
    Dim arrFieldnames As Variant
    Dim arrValues As Variant
    Dim arrRecordvals As Variant
    On Error GoTo ErrorHandler
    arrFieldnames = Array("sBomHeader", "sBomDes", _
                          "sMaNo", "sMaDes", "sMaUoM", "nMaQty")     'change as needed

    'Speed up execution by disabling screen updating
    Application.ScreenUpdating = False

    'Make a connection to your database file
    Set conn = New ADODB.Connection
    With conn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "data source=" & DBPath
        .Open
    End With

    'Create a *new* recordset here because we overwrite the ones in the existing table
    Set ADOrst = New ADODB.Recordset

    'Use a client cursor and adLockBatchOptimistic to do batch updates
    ADOrst.CursorLocation = adUseClient
    ADOrst.Open DBTable, conn, adOpenStatic, adLockBatchOptimistic

    'Find the last row(number) with data in Sheet1
    With ThisWorkbook.Worksheets("BOM_09092008")
        iLastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    End With

    'Clear the table
    ClearTable (DBTable)

    'Assign your worksheet values in one statement to the variable arrValues (type Variant)
    arrValues = ThisWorkbook.Worksheets("BOM_09092008").Range("A2:M" & iLastrow).Value

    'Stuff the worksheet values into the recordset
    For i = 1 To UBound(arrValues, 1)
        If Len(arrValues(i, 9)) > 0 Then
            arrRecordvals = Array(arrValues(i, 1), arrValues(i, 2), _
                                  arrValues(i, 9), arrValues(i, 10), _
                                  arrValues(i, 13), arrValues(i, 12))
            ADOrst.AddNew arrFieldnames, arrRecordvals
            Application.StatusBar = "Update to record " & i & "/" & iLastrow - 1
        End If
    Next i

    Application.StatusBar = "Batch updating...Please wait."
    '(Batch)Update the table with the just created recordset
    [B]ADOrst.UpdateBatch
[/B]
    'Close the recordset
    ADOrst.Close

    'Close database connection
    conn.Close

    'Inform the user
    MsgBox "Updating is successful.", vbOKOnly + vbInformation, "Inf"

ErrorExit:
    'Clean up
    Set ADOrst = Nothing
    Set arrValues = Nothing
    Set arrRecordvals = Nothing
    Set arrFieldnames = Nothing

    'Re-enable screen updating
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Exit Sub

ErrorHandler:
    MsgBox "Error is " & Err.Number & "; Error description: " & Err.Description
    Resume ErrorExit
End Sub

Sub ClearTable(sTable As String)
    'Thủ tục này nhằm xóa dữ liệu trong bảng
    With New ADODB.Connection
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Open DBPath
    .Execute "DELETE FROM " & sTable
    .Close
    End With
End Sub

Tôi đã test thủ tục trên với hơn 70,000 records và có vài nhận xét như sau:
1. Bằng việc dùng mảng từ đối tượng Range code của các bạn sẽ nhanh hơn.

arrValues = ThisWorkbook.Worksheets("BOM_09092008").Range("A2:M" & iLastrow).Value

2. Đối với dữ liệu quá lớn, các thao tác thêm vào trước khi gọi phương thức UpdateBatch thực hiện rất nhanh. Nhưng khi các bạn gọi phương thức này thì chương trình của bạn sẽ "bị treo" một thời gian, mới thực hiện xong. Vậy nên, cách tốt nhất là chúng ta chia dữ liệu thành nhiều phần nhỏ (giả sử chia thành nhiều sheets chẳng hạn), rồi cập nhật theo từng phần là tốt nhất.

Lê Văn Duyệt

 

[hai2hai]

Anh Duyệt nên chuyển sang cách dùng SQL thay vì dùng ADO Recordset thế này anh ạ.

UPDATE tb_TableName SET ... WHERE...

Cũng như hai2hai nói ở nhiều bài trước, mỗi data object (ví dụ BOM, StockTransaction, PaymentTransaction,...) đều có method để execute SQL chứ ko nên viết truy cập vào CSDL ở tứ xứ các nơi như ở trên.

P/S: Trong coding, nếu ko cần thiết thì hạn chế dùng biến Variant, biến Array.

 

[levanduyet]

Tôi thấy một so sánh cũng hay, xin chia sẽ cùng các bạn:

What is the fastest way to scan a large range in Excel? Cách nhanh nhất để duyệt qua một vùng lớn trong Excel?

Problem description-Vấn đề:

You have a large range in Excel with data. Let's say it contains 100,000 rows and 50 columns for each row (Yes you are using Excel 2007 of course). So altogether you have 5,000,000 cells. Columns A to F have some alphanumeric data that you need analyze and based on the combination of values for each row you need to use the numeric values in G to H to do some calculations and store the results in columns I and J. You could place 200,000 formulas in I and J but you see that a spreadsheet with such a volume of formulas gets very sow and consumes huge amounts of memory.

You decide to try and solve it in a piece of VBA code. The question is how to implement such a task in the most efficient way?
What are your options

How can you scan a range in Excel, read the values in some cells, and change some others?
Use a range object

Let's assume that the range you want to read starts at A1

The code looks something like this:

    Dim DataRange as Range ' Could also be Dim DataRange as Object
    Dim Irow as Long
    Dim MaxRows as Long
    Dim Icol as Integer
    Dim MaxCols as Long
    Dim MyVar as Double
    Set DataRange=Range("A1").CurrentRegion
    MaxRows= Range("A1").CurrentRegion.Rows.Count
    MaxCols= Range("A1").CurrentRegion.Columns.Count
    For Irow=1 to MaxRows 
      For icol=1 to MaxCols 
        MyVar=DataRange(Irow,Icol) 
        If MyVar > 0 then 
          MyVar=MyVar*Myvar ' Change the value 
          DataRange(Irow,Icol)=MyVar 
        End If 
      Next Icol
    Next Irow

Use the selection and move it using offset

Many VBA developers learned VBA techniques from macro recording.

When using relative reference the generated VBA code creates statements like:

    ActiveCell.Offset(0, -1).Range("A1").Select

As a consequence many developers adopt this technique and use the ActiveCell or selection ranges to move from cell to cell in code and read or write the cell values. The code will look like this:

    Dim Irow As Long
    Dim MaxRows As Long
    Dim Icol As Integer
    Dim MaxCols As Long
    Dim MyVar As Double
    Range("A1").Select
    MaxRows = Range("A1").CurrentRegion.Rows.Count
    MaxCols = Range("A1").CurrentRegion.Columns.Count
    For Irow = 1 To MaxRows 
      For Icol = 1 To MaxCols 
        MyVar = ActiveCell.Value 
        If MyVar > 0 Then 
          MyVar=MyVar*Myvar ' Change the value 
          ActiveCell.Value = MyVar 
        End If 
        [COLOR="Red"]ActiveCell.Offset(0, 1).Select [/COLOR]' Move one column to the right 
      Next Icol 
      [COLOR="Red"]ActiveCell.Offset(1, -MaxCols).Select[/COLOR] ' Move one rows down and back to first column
    Next Irow

Use a variant type variable

This technique copies the values from all cells in the range into a variable in memory, manipulates the values inside this variable and if needed moves the values back to the range after manipulation.

Here is the code this time:

    [COLOR="Red"]Dim DataRange As Variant[/COLOR]
    Dim Irow As Long
    Dim MaxRows As Long
    Dim Icol As Integer
    Dim MaxCols As Long
    Dim MyVar As Double
    [COLOR="Red"]DataRange = Range("A1").CurrentRegion.Value[/COLOR] ' Not using set
    MaxRows = Range("A1").CurrentRegion.Rows.Count
    MaxCols = Range("A1").CurrentRegion.Columns.Count
    For Irow = 1 To MaxRows 
      For Icol = 1 To MaxCols 
      MyVar = DataRange(Irow, Icol) 
      If MyVar > 0 Then 
        MyVar=MyVar*Myvar ' Change the value 
        DataRange(Irow, Icol) = MyVar 
      End If
    Next Icol
    Next Irow
    [COLOR="Red"]Range("A1").CurrentRegion = DataRange[/COLOR] ' writes back the result to the range

Another difference is that this method is blazing fast compared to the two others.

Performance Summary

I compared the three methods on relatively large ranges and here are the results:

Method | Operation | Cells/Sec Variant |Read|1,225,490
|Write|714,286
|Read/Write|263,158
Range |Read|250,000
|Write|1818
|Read/Write|1,852
Offset |Read|206
|Write|200
|Read/Write|203

As you can see using a variant variable is much faster especially when changing cells. Even if the calculation can be done with Excel formulas, in some cases this method is the only one acceptable because using a very large number of formulas can become very slow.

Obviously the one method to avoid is moving the ActiveCell using Offset.

http://blogs.msdn.com/excel/archive...stest-way-to-scan-a-large-range-in-excel.aspx

Lê Văn Duyệt

 

[levanduyet]

Một ví dụ tương tự

Dùng Offset

Sub LoopFillRange()
'   Fill a range by looping through cells
    Dim CellsDown As Long, CellsAcross As Long
    Dim CurrRow As Long, CurrCol As Long
    Dim StartTime As Double
    Dim CurrVal As Long

'   Change these values
    CellsDown = 500
    CellsAcross = 200
   
    Cells.Clear
'   Record starting time
    StartTime = Timer

'   Loop through cells and insert values
    CurrVal = 1
    Application.ScreenUpdating = False
    For CurrRow = 1 To CellsDown
        For CurrCol = 1 To CellsAcross
            Range("A1").Offset(CurrRow - 1, CurrCol - 1).Value = CurrVal
            CurrVal = CurrVal + 1
        Next CurrCol
    Next CurrRow

'   Display elapsed time
    Application.ScreenUpdating = True
    MsgBox Format(Timer - StartTime, "00.00") & " seconds"
End Sub

Dùng array

Sub ArrayFillRange()
'   Fill a range by transferring an array
    Dim CellsDown As Long, CellsAcross As Long
    Dim i As Long, j As Long
    Dim StartTime As Double
    Dim TempArray() As Double
    Dim TheRange As Range
    Dim CurrVal As Long

'   Change these values
    CellsDown = 500
    CellsAcross = 200

    Cells.Clear
'   Record starting time
    StartTime = Timer

'   Redimension temporary array
    ReDim TempArray(1 To CellsDown, 1 To CellsAcross)

'   Set worksheet range
    Set TheRange = Range(Cells(1, 1), Cells(CellsDown, CellsAcross))

'   Fill the temporary array
    CurrVal = 0
    Application.ScreenUpdating = False
    For i = 1 To CellsDown
        For j = 1 To CellsAcross
            TempArray(i, j) = CurrVal
            CurrVal = CurrVal + 1
        Next j
    Next i

'   Transfer temporary array to worksheet
    TheRange.Value = TempArray

'   Display elapsed time
    Application.ScreenUpdating = True
    MsgBox Format(Timer - StartTime, "00.00") & " seconds"
End Sub

Với hai cách trên nếu chúng ta viết 100,000 giá trị thì cách Offset sẽ mất 9.73 giây còn cách dùng array mất 0.16 giây. Tức là khoảng 60 lần nhanh hơn.

http://www.dailydoseofexcel.com/archives/2006/12/04/writing-to-a-range-using-vba/

Lê Văn Duyệt