Tặng các bạn module "modFastArray" - Các hàm xử lý mảng trong bộ nhớ - Tốc độ nhanh! (1 người xem)

[Nguyễn Duy Tuân]

Chúng ta đã biết lập trình VBA trong Excel với việc xử lý dữ liệu lớn rồi ghi lên bảng tính, bình thường chạy bị chậm. Phương pháp làm tăng tốc độ là xử lý trong mảng rồi điền cả mảng vào bảng tính. Thông thường khi làm với mảng, các công việc như xoá các phần tử trong mảng, chèn thêm dữ liệu vào mảng, chúng ta sẽ dùng vòng lặp để làm và tốc độ ứng dụng chạy vẫn bị chậm nếu mảng dữ liệu lớn. Từ nhu cầu thực tế và qua trao đổi trong chủ để "Array: Có thể remove một hay vài hàng bất kỳ mà không dùng vòng lặp được không?" của anh Hoàng Trọng Nghĩa tôi xây dựng một module tên "modFastArray" cung cấp các hàm xử lý mảng với giải thuật không dùng vòng lặp mà xử lý việc dịch chuyển các byte (dữ liệu) của mảng trong bộ nhớ nên tốc độ chạy rất nhanh!

Phiên bản 1.0->1.1 cung cấp các hàm mảng sau:

1. DeleteElementArray1D - Cho phép xoá một hay nhiều phần tử mảng (1 chiều - 1D) liên tiếp
2. DeleteElementArray2D - Cho phép xoá một hay nhiều phần tử mảng (2 chiều - 2D) liên tiếp
3. InsertElementArray1D - Cho phép chèn một mảng dữ liệu vào một mảng đã có vào vị trí bất kỳ. Hàm này làm việc với mảng 1 chiều chiều
4. InsertElementArray2D - Cho phép chèn một mảng dữ liệu vào một mảng đã có vào vị trí bất kỳ. Hàm này làm việc với mảng 2 chiều
5. ConvertArray1DTo2D - Cho phép chuyển đổi từ mảng 1 chiều sang mảng 2 chiều. Hàm này hữu dụng khi ta cần đưa mảng vào bảng tính. Mảng đưa vào muốn trình bày trong một cột thì phải đưa về mảng hai chiều. Đặc biệt nó tốt hơn hàm Excel Application.WorksheetFunction.Transpose() rất nhiều khi làm việc với mảng 1 chiều và số phần tử mảng lớn (lên đến trên 100.000 phần tử).
6. FillToRange - Cho phép điền mảng vào bảng tính tại ô bất kỳ
7. NumberOfDimensions - Đếm số chiều của mảng
8 DeleteColumnArray2D - Xóa cac cột trong mảng 2 chiều
9 InsertColumnArray2D - Chèn thêm các cột từ mảng khác vào mảng 2 chiều

Để biết cách sử dụng các bạn hãy download tập tin "FastArray_vx.x.xls"đính kèm.

(*) Khi sử dụng cần lưu ý:
+ Các phần tử của mảng phải là kiểu VARIANT
+ Đọc kỹ các comment trong mỗi hàm để nắm được quy tắc cũng như mục đích sử dụng hàm và của từng tham số.

Mã nguồn các hàm dưới đây:

[GPECODE=vb]
Function DeleteElementArray1D(ByRef arrDest() As Variant, ByRef arrSource As Variant, ByVal lIndexBegin As Long, ByVal lIndexEnd As Long) As Boolean
'Programming by: Nguyen Duy Tuan - www.bluesofts.net
'arrSource: is array 1D. Elements of array with VARIANT type
'arrDest: an array 1D after deleting element from lIndexBegin to lIndexEnd. Elements of array with VARIANT type
Dim I As Long, lLowSource As Long

Erase arrDest 'Free all elements

lLowSource = LBound(arrSource)
'Check the validity of the parameters
If (lIndexEnd < lLowSource) Or (lIndexEnd > UBound(arrSource)) Then
lIndexEnd = UBound(arrSource)
End If
If lIndexBegin < lLowSource Then
Err.Raise 10000, "DeleteElementArray1D", "Parameter lIndexBegin is invalid."
End If
If (lIndexBegin > lIndexEnd) Then
Err.Raise 10001, "DeleteElementArray1D", "You must ensure that lIndexBegin <= lIndexEnd."
End If
If (lIndexEnd - lIndexBegin) = (UBound(arrSource) - lLowSource) Then '<==> Clear all elements of array
ReDim arrDest(lLowSource To lLowSource)
DeleteElementArray1D = True
Exit Function
End If

ReDim arrDest(lLowSource To UBound(arrSource) - (lIndexEnd - lIndexBegin + 1)) As Variant

CopyMemory ByVal VarPtr(arrDest(lLowSource)), _
ByVal VarPtr(arrSource(lLowSource)), _
SZ_VARIANT * ((lIndexBegin - lLowSource))

If UBound(arrSource) > lIndexEnd Then 'the rest
CopyMemory ByVal VarPtr(arrDest(lIndexBegin)), _
ByVal VarPtr(arrSource(lIndexEnd + 1)), _
SZ_VARIANT * (UBound(arrSource) - lIndexEnd)
End If

'Erase Source array in memory
'Must move bytes should be deleted from arrSource(lIndexBegin to lIndexEnd) into arrDelSource to free them in memory
ReDim arrDelSource(lIndexBegin To lIndexEnd) As Variant
CopyMemory ByVal VarPtr(arrDelSource(lIndexBegin)), _
ByVal VarPtr(arrSource(lIndexBegin)), _
SZ_VARIANT * (lIndexEnd - lIndexBegin + 1)
Erase arrDelSource
ZeroMemory ByVal VarPtr(arrSource(lLowSource)), SZ_VARIANT * (UBound(arrSource) - lLowSource + 1)
Erase arrSource
DeleteElementArray1D = True
End Function

Function DeleteElementArray2D(ByRef arrDest() As Variant, ByRef arrSource As Variant, ByVal lIndexBegin As Long, ByVal lIndexEnd As Long) As Boolean
'Programming by: Nguyen Duy Tuan - www.bluesofts.net
'arrSource: is array 2D. Elements of array with VARIANT type
'arrDest: an array after deleting element from lIndexBegin to lIndexEnd. Elements of array with VARIANT type
Dim I As Long, lLowSourceD1 As Long, lLowSourceD2 As Long

Erase arrDest 'Free all elements

lLowSourceD1 = LBound(arrSource, 1)
lLowSourceD2 = LBound(arrSource, 2)
'Check the validity of the parameters
If (lIndexEnd < lLowSourceD1) Or (lIndexEnd > UBound(arrSource, 1)) Then
lIndexEnd = UBound(arrSource, 1)
End If
If lIndexBegin < lLowSourceD1 Then
Err.Raise 10000, "DeleteElementArray2D", "Parameter lIndexBegin is invalid."
End If
If lIndexBegin > lIndexEnd Then
Err.Raise 10001, "DeleteElementArray2D", "You must ensure that lIndexBegin <= lIndexEnd."
End If

ReDim arrDest(lLowSourceD1 To UBound(arrSource, 1) - (lIndexEnd - lIndexBegin + 1), _
lLowSourceD2 To UBound(arrSource, 2)) As Variant

For I = LBound(arrSource, 2) To UBound(arrSource, 2) 'Copy columns
CopyMemory ByVal VarPtr(arrDest(lLowSourceD1, I)), _
ByVal VarPtr(arrSource(lLowSourceD1, I)), _
SZ_VARIANT * (lIndexBegin - lLowSourceD1)
Next I
If UBound(arrSource) > lIndexEnd Then
For I = LBound(arrSource, 2) To UBound(arrSource, 2)
CopyMemory ByVal VarPtr(arrDest(lIndexBegin, I)), _
ByVal VarPtr(arrSource(lIndexEnd + 1, I)), _
SZ_VARIANT * (UBound(arrSource) - lIndexEnd)
Next I
End If

'Erase Source array in memory
ReDim arrDelSource(lIndexBegin To lIndexEnd, lLowSourceD2 To UBound(arrSource, 2)) As Variant
For I = LBound(arrSource, 2) To UBound(arrSource, 2)
'Must move bytes should be deleted from arrSource(lIndexBegin to lIndexEnd) into arrDelSource to free them in memory
CopyMemory ByVal VarPtr(arrDelSource(lIndexBegin, I)), _
ByVal VarPtr(arrSource(lIndexBegin, I)), _
SZ_VARIANT * (lIndexEnd - lIndexBegin + 1)
ZeroMemory ByVal VarPtr(arrSource(lLowSourceD1, I)), SZ_VARIANT * (UBound(arrSource) - lLowSourceD1 + 1)
Next I
Erase arrDelSource
Erase arrSource
DeleteElementArray2D = True
End Function

Function DeleteColumnArray2D(ByRef arrDest() As Variant, ByRef arrSource As Variant, ByVal lIndexBegin As Long, ByVal lIndexEnd As Long) As Boolean
'Programming by: Nguyen Duy Tuan - www.bluesofts.net
'arrSource: is array 2D. Elements of array with VARIANT type
'arrDest: an array2D after deleting columns of data from lIndexBegin to lIndexEnd. Elements of array with VARIANT type
Dim I As Long, lLowSourceD1 As Long, lHighSourceD1 As Long, lLowSourceD2 As Long

Erase arrDest 'Free all elements

lLowSourceD1 = LBound(arrSource, 1)
lHighSourceD1 = UBound(arrSource, 1)
lLowSourceD2 = LBound(arrSource, 2)
'Check the validity of the parameters
If (lIndexEnd < lLowSourceD2) Or (lIndexEnd > UBound(arrSource, 2)) Then
lIndexEnd = UBound(arrSource, 2)
End If
If lIndexBegin < lLowSourceD1 Then
Err.Raise 10000, "DeleteElementArray2D", "Parameter lIndexBegin is invalid."
End If
If lIndexBegin > lIndexEnd Then
Err.Raise 10001, "DeleteElementArray2D", "You must ensure that lIndexBegin <= lIndexEnd."
End If

ReDim arrDest(lLowSourceD1 To UBound(arrSource, 1), _
lLowSourceD2 To UBound(arrSource, 2) - (lIndexEnd - lIndexBegin + 1)) As Variant
Dim lColIndex As Long
lColIndex = lLowSourceD2 - 1
For I = lLowSourceD2 To UBound(arrSource, 2) 'Copy columns
If I < lIndexBegin Or I > lIndexEnd Then
lColIndex = lColIndex + 1
CopyMemory ByVal VarPtr(arrDest(lLowSourceD1, lColIndex)), _
ByVal VarPtr(arrSource(lLowSourceD1, I)), _
SZ_VARIANT * ((lHighSourceD1 - lLowSourceD1 + 1))
End If
Next I

DeleteColumnArray2D = True

'Erase Source array in memory
ReDim arrDelSource(lLowSourceD1 To lHighSourceD1, _
lIndexBegin To lIndexEnd) As Variant
lColIndex = lIndexBegin - 1
For I = LBound(arrSource, 2) To UBound(arrSource, 2)
'Must move bytes should be deleted from arrSource(lIndexBegin to lIndexEnd) into arrDelSource to free them in memory
If I >= lIndexBegin And I <= lIndexEnd Then
lColIndex = lColIndex + 1
CopyMemory ByVal VarPtr(arrDelSource(lLowSourceD1, lColIndex)), _
ByVal VarPtr(arrSource(lLowSourceD1, I)), _
SZ_VARIANT * ((lHighSourceD1 - lLowSourceD1 + 1))
End If
ZeroMemory ByVal VarPtr(arrSource(lLowSourceD1, I)), SZ_VARIANT * (lHighSourceD1 - lLowSourceD1 + 1)
Next I
Erase arrDelSource
Erase arrSource
End Function

Function InsertElementArray1D(ByRef arrDest() As Variant, ByRef arrSource1 As Variant, ByVal lIndex As Long, ByRef arrSource2 As Variant) As Boolean
'Programming by: Nguyen Duy Tuan - www.bluesofts.net
'arrSource1: is array 1D. Elements of array with VARIANT type
'arrSource2: is array 1D. Elements of array with VARIANT type, it is inserted into arrSource1 at position lIndex
'arrDest: an array 1D contents arrSource1 and arrSource2
Dim I As Long, lLowSource1 As Long, lLowSource2 As Long, lHighSource2 As Long

Erase arrDest 'Free all elements

lLowSource1 = LBound(arrSource1)
'Check the validity of the parameters
If (lIndex < lLowSource1) Or (lIndex > UBound(arrSource1)) Then
lIndex = UBound(arrSource1) + 1 'insert array at the end of arrSource1 array
End If
lLowSource2 = LBound(arrSource2)
lHighSource2 = UBound(arrSource2)
ReDim arrDest(lLowSource1 To UBound(arrSource1) + (lHighSource2 - lLowSource2 + 1)) As Variant
CopyMemory ByVal VarPtr(arrDest(lLowSource1)), _
ByVal VarPtr(arrSource1(lLowSource1)), _
SZ_VARIANT * ((lIndex - lLowSource1))
'Insert arrSource2 into arrSource1 at position lIndex of arrSource1
CopyMemory ByVal VarPtr(arrDest(lIndex)), _
ByVal VarPtr(arrSource2(LBound(arrSource2))), _
SZ_VARIANT * (lHighSource2 - lLowSource2 + 1)
If UBound(arrSource1) >= lIndex Then 'the rest
CopyMemory ByVal VarPtr(arrDest(lIndex + (lHighSource2 - lLowSource2 + 1))), _
ByVal VarPtr(arrSource1(lIndex)), _
SZ_VARIANT * (UBound(arrSource1) - lIndex + 1)
End If

'Erase Source array in memory
ZeroMemory ByVal VarPtr(arrSource1(lLowSource1)), SZ_VARIANT * (UBound(arrSource1) - lLowSource1 + 1)
Erase arrSource1
ZeroMemory ByVal VarPtr(arrSource2(lLowSource2)), SZ_VARIANT * (UBound(arrSource2) - lLowSource2 + 1)
Erase arrSource2
InsertElementArray1D = True
End Function

Function InsertElementArray2D(ByRef arrDest() As Variant, ByRef arrSource1 As Variant, ByVal lIndex As Long, ByRef arrSource2 As Variant) As Boolean
'Programming by: Nguyen Duy Tuan - www.bluesofts.net
'arrSource1: is array 2D. Elements of array with VARIANT type
'arrSource2: is array 2D. Elements of array with VARIANT type, it is inserted into arrSource1 at position lIndex
'arrDest: an array 2D contents arrSource1 and arrSource2
Dim I As Long
Dim lLowSource1D1 As Long, lLowSource1D2 As Long
Dim lLowSource2D1 As Long, lHighSource2D1 As Long

Erase arrDest 'Free all elements

lLowSource1D1 = LBound(arrSource1, 1)
lLowSource1D2 = LBound(arrSource1, 2)
lLowSource2D1 = LBound(arrSource2, 1)
lHighSource2D1 = UBound(arrSource2, 1)

'Check the validity of the parameters
If lIndex < lLowSource1D1 Or lIndex > UBound(arrSource1) Then
lIndex = UBound(arrSource1) + 1 'insert array at the end of arrSource1 array
End If
If (UBound(arrSource1, 2) - LBound(arrSource1, 2)) <> (UBound(arrSource2, 2) - LBound(arrSource2, 2)) Or _
UBound(arrSource1, 2) <> UBound(arrSource2, 2) Then
Err.Raise 10002, "InsertElementArray2D", "arrSource1 and arrSource2 have different structures."
End If

ReDim arrDest(lLowSource1D1 To UBound(arrSource1, 1) + (lHighSource2D1 - lLowSource2D1 + 1), _
lLowSource1D2 To UBound(arrSource1, 2)) As Variant

For I = LBound(arrSource1, 2) To UBound(arrSource1, 2) 'Copy columns
CopyMemory ByVal VarPtr(arrDest(lLowSource1D1, I)), _
ByVal VarPtr(arrSource1(lLowSource1D1, I)), _
SZ_VARIANT * ((lIndex - lLowSource1D1))
Next I
'Insert arrSource2 into arrSource1 at position lIndex of arrSource1
For I = LBound(arrSource1, 2) To UBound(arrSource1, 2) 'Copy columns
CopyMemory ByVal VarPtr(arrDest(lIndex, I)), _
ByVal VarPtr(arrSource2(LBound(arrSource2), I)), _
SZ_VARIANT * (lHighSource2D1 - lLowSource2D1 + 1)
Next I
If UBound(arrSource1, 1) >= lIndex Then 'the rest
For I = LBound(arrSource1, 2) To UBound(arrSource1, 2) 'Copy columns
CopyMemory ByVal VarPtr(arrDest(lIndex + (lHighSource2D1 - lLowSource2D1 + 1), I)), _
ByVal VarPtr(arrSource1(lIndex, I)), _
SZ_VARIANT * (UBound(arrSource1) - lIndex + 1)
Next I
End If

'Erase Source array in memory
For I = LBound(arrSource1, 2) To UBound(arrSource1, 2)
ZeroMemory ByVal VarPtr(arrSource1(lLowSource1D1, I)), _
SZ_VARIANT * (UBound(arrSource1) - lLowSource1D1 + 1)
Next I
Erase arrSource1
For I = LBound(arrSource2, 2) To UBound(arrSource2, 2)
ZeroMemory ByVal VarPtr(arrSource2(lLowSource1D1, I)), _
SZ_VARIANT * (UBound(arrSource2) - lLowSource2D1 + 1)
Next I
Erase arrSource2
InsertElementArray2D = True
End Function
[/GPECODE]

Bộ hàm trên tương thích với các môi trường Windows , Office 32 và 64-bit.

Hy vọng bộ hàm này giúp ích được các bạn khi xây dựng ứng dụng với tốc độ chạy nhanh. Rất mong các bạn góp ý thêm để bộ hàm được hoàn thiện hơn.

Phiên bản mới nhất là FastArray_v1.1

 

[siwtom]

Chúng ta đã biết lập trình VBA trong Excel với việc xử lý dữ liệu lớn rồi ghi lên bảng tính, bình thường chạy bị chậm. Phương pháp làm tăng tốc độ là xử lý trong mảng rồi điền cả mảng vào bảng tính. Thông thường khi làm với mảng, các công việc như xoá các phần tử trong mảng, chèn thêm dữ liệu vào mảng, chúng ta sẽ dùng vòng lặp để làm và tốc độ ứng dụng chạy vẫn bị chậm nếu mảng dữ liệu lớn. Từ nhu cầu thực tế và qua trao đổi trong chủ để "Array: Có thể remove một hay vài hàng bất kỳ mà không dùng vòng lặp được không?" của anh Hoàng Trọng Nghĩa tôi xây dựng một module tên "modFastArray" cung cấp các hàm xử lý mảng với giải thuật không dùng vòng lặp mà xử lý việc dịch chuyển các byte (dữ liệu) của mảng trong bộ nhớ nên tốc độ chạy rất nhanh!

Phiên bản 1.0 cung cấp các hàm mảng sau:

1. DeleteElementArray1D - Cho phép xoá một hay nhiều phần tử mảng (1 chiều - 1D) liên tiếp
2. DeleteElementArray2D - Cho phép xoá một hay nhiều phần tử mảng (2 chiều - 2D) liên tiếp
3. InsertElementArray1D - Cho phép chèn một mảng dữ liệu vào một mảng đã có vào vị trí bất kỳ. Hàm này làm việc với mảng 1 chiều chiều
4. InsertElementArray2D - Cho phép chèn một mảng dữ liệu vào một mảng đã có vào vị trí bất kỳ. Hàm này làm việc với mảng 2 chiều
5. ConvertArray1DTo2D - Cho phép chuyển đổi từ mảng 1 chiều sang mảng 2 chiều. Hàm này hữu dụng khi ta cần đưa mảng vào bảng tính. Mảng đưa vào muốn trình bày trong một cột thì phải đưa về mảng hai chiều. Đặc biệt nó tốt hơn hàm Excel Application.WorksheetFunction.Transpose() rất nhiều khi làm việc với mảng 1 chiều và số phần tử mảng lớn (lên đến trên 100.000 phần tử).
6. FillToRange - Cho phép điền mảng vào bảng tính tại ô bất kỳ
7. NumberOfDimensions - Đếm số chiều của mảng

Để biết cách sử dụng các bạn hãy download tập tin "FastArray_vx.x.xls"đính kèm.

(*) Khi sử dụng cần lưu ý:
+ Các phần tử của mảng phải là kiểu VARIANT
+ Đọc kỹ các comment trong mỗi hàm để nắm được quy tắc cũng như mục đích sử dụng hàm và của từng tham số.

Mã nguồn các hàm dưới đây:

[GPECODE=vb]
Function DeleteElementArray1D(ByVal arrSource As Variant, ByVal lIndexBegin As Long, ByVal lIndexEnd As Long) As Variant
'Programming by: Nguyen Duy Tuan - www.bluesofts.net
'arrSource: is array 1D. Elements of array with VARIANT type
'Return: an array 1D after deleting element from lIndexBegin to lIndexEnd. Elements of array with VARIANT type
Dim I As Long, lLowArray As Long

lLowArray = LBound(arrSource)
'Check Parameters valid
If (lIndexEnd < lLowArray) Or (lIndexEnd > UBound(arrSource)) Then
lIndexEnd = UBound(arrSource)
End If
If lIndexBegin < lLowArray Then
Err.Raise 10000, "DeleteElementArray1D", "Parameter lIndexBegin is invalid."
End If
If (lIndexBegin > lIndexEnd) Then
Err.Raise 10001, "DeleteElementArray1D", "You must ensure that lIndexBegin <= lIndexEnd."
End If

ReDim out(lLowArray To UBound(arrSource) - (lIndexEnd - lIndexBegin + 1)) As Variant

CopyMemory ByVal VarPtr(out(lLowArray)), _
ByVal VarPtr(arrSource(lLowArray)), _
SZ_VARIANT * ((lIndexBegin - lLowArray))

If UBound(arrSource) > lIndexEnd Then 'the rest
CopyMemory ByVal VarPtr(out(lIndexBegin)), _
ByVal VarPtr(arrSource(lIndexEnd + 1)), _
SZ_VARIANT * (UBound(arrSource) - lIndexEnd)
End If
'Return array after deleting
DeleteElementArray1D = out

'Erase source array in memory
ZeroMemory ByVal VarPtr(arrSource(lLowArray)), SZ_VARIANT * (UBound(arrSource) - lLowArray + 1)
Erase arrSource
End Function

Function DeleteElementArray2D(ByVal arrSource As Variant, ByVal lIndexBegin As Long, ByVal lIndexEnd As Long) As Variant
'Programming by: Nguyen Duy Tuan - www.bluesofts.net
'arrSource: is array 2D. Elements of array with VARIANT type
'Return: an array after deleting element from lIndexBegin to lIndexEnd. Elements of array with VARIANT type
Dim I As Long, lLowArrayD1 As Long, lLowArrayD2 As Integer

lLowArrayD1 = LBound(arrSource, 1)
lLowArrayD2 = LBound(arrSource, 2)
'Check Parameters valid
If (lIndexEnd < lLowArrayD1) Or (lIndexEnd > UBound(arrSource, 1)) Then
lIndexEnd = UBound(arrSource, 1)
End If
If lIndexBegin < lLowArrayD1 Then
Err.Raise 10000, "DeleteElementArray2D", "Parameter lIndexBegin is invalid."
End If
If lIndexBegin > lIndexEnd Then
Err.Raise 10001, "DeleteElementArray2D", "You must ensure that lIndexBegin <= lIndexEnd."
End If

ReDim out(lLowArrayD1 To UBound(arrSource, 1) - (lIndexEnd - lIndexBegin + 1), _
lLowArrayD2 To UBound(arrSource, 2)) As Variant

For I = LBound(arrSource, 2) To UBound(arrSource, 2) 'Copy columns
CopyMemory ByVal VarPtr(out(lLowArrayD1, I)), _
ByVal VarPtr(arrSource(lLowArrayD1, I)), _
SZ_VARIANT * ((lIndexBegin - lLowArrayD1))
Next I
If UBound(arrSource) > lIndexEnd Then
For I = LBound(arrSource, 2) To UBound(arrSource, 2)
CopyMemory ByVal VarPtr(out(lIndexBegin, I)), _
ByVal VarPtr(arrSource(lIndexEnd + 1, I)), _
SZ_VARIANT * (UBound(arrSource) - lIndexEnd)
Next I
End If

'Return array after deleting
DeleteElementArray2D = out

'Erase source array in memory
For I = LBound(arrSource, 2) To UBound(arrSource, 2)
ZeroMemory ByVal VarPtr(arrSource(lLowArrayD1, I)), SZ_VARIANT * (UBound(arrSource) - lLowArrayD1 + 1)
Next I
Erase arrSource
End Function

Function InsertElementArray1D(ByVal arrSource1 As Variant, ByVal lIndex As Long, ByVal arrSource2 As Variant) As Variant
'Programming by: Nguyen Duy Tuan - www.bluesofts.net
'arrSource1: is array 1D. Elements of array with VARIANT type
'arrSource2: is array 1D. Elements of array with VARIANT type, it is inserted into arrSource1 at position lIndex
'Return: an array 1D contents arrSource1 and arrSource2
Dim I As Long, lLowSource1 As Long, lLowSource2 As Long, lHighSource2 As Long

lLowSource1 = LBound(arrSource1)
'Check Parameters valid
If (lIndex < lLowSource1) Or (lIndex > UBound(arrSource1)) Then
lIndex = UBound(arrSource1) + 1 'insert array at the end
End If
lLowSource2 = LBound(arrSource2)
lHighSource2 = UBound(arrSource2)
ReDim out(lLowSource1 To UBound(arrSource1) + (lHighSource2 - lLowSource2 + 1)) As Variant
CopyMemory ByVal VarPtr(out(lLowSource1)), _
ByVal VarPtr(arrSource1(lLowSource1)), _
SZ_VARIANT * ((lIndex - lLowSource1))
'Append array arrSource2 to arrSource1 at lIndex
CopyMemory ByVal VarPtr(out(lIndex)), _
ByVal VarPtr(arrSource2(LBound(arrSource2))), _
SZ_VARIANT * (lHighSource2 - lLowSource2 + 1)
If UBound(arrSource1) >= lIndex Then 'the rest
CopyMemory ByVal VarPtr(out(lIndex + (lHighSource2 - lLowSource2 + 1))), _
ByVal VarPtr(arrSource1(lIndex)), _
SZ_VARIANT * (UBound(arrSource1) - lIndex + 1)
End If
'Return array after deleting
InsertElementArray1D = out

'Erase source array in memory
ZeroMemory ByVal VarPtr(arrSource1(lLowSource1)), SZ_VARIANT * (UBound(arrSource1) - lLowSource1 + 1)
Erase arrSource1
ZeroMemory ByVal VarPtr(arrSource2(lLowSource2)), SZ_VARIANT * (UBound(arrSource2) - lLowSource2 + 1)
Erase arrSource2
End Function

Function InsertElementArray2D(ByVal arrSource1 As Variant, ByVal lIndex As Long, ByVal arrSource2 As Variant) As Variant
'Programming by: Nguyen Duy Tuan - www.bluesofts.net
'arrSource1: is array 1D. Elements of array with VARIANT type
'arrSource2: is array 1D. Elements of array with VARIANT type, it is inserted into arrSource1 at position lIndex
'Return: an array 1D contents arrSource1 and arrSource2
Dim I As Long
Dim lLowSource1D1 As Long, lLowSource1D2 As Long
Dim lLowSource2D1 As Long, lHighSource2D1 As Long

lLowSource1D1 = LBound(arrSource1, 1)
lLowSource1D2 = LBound(arrSource1, 2)
lLowSource2D1 = LBound(arrSource2, 1)
lHighSource2D1 = UBound(arrSource2, 1)

'Check Parameters valid
If lIndex < lLowSource1D1 Or lIndex > UBound(arrSource1) Then
lIndex = UBound(arrSource1) + 1 'insert array at the end
End If
If (UBound(arrSource1, 2) - LBound(arrSource1, 2)) <> (UBound(arrSource2, 2) - LBound(arrSource2, 2)) Or _
UBound(arrSource1, 2) <> UBound(arrSource2, 2) Then
Err.Raise 10002, "InsertElementArray2D", "arrSource1 and arrSource2 have different structures."
End If

ReDim out(lLowSource1D1 To UBound(arrSource1, 1) + (lHighSource2D1 - lLowSource2D1 + 1), _
lLowSource1D2 To UBound(arrSource1, 2)) As Variant

For I = LBound(arrSource1, 2) To UBound(arrSource1, 2) 'Copy columns
CopyMemory ByVal VarPtr(out(lLowSource1D1, I)), _
ByVal VarPtr(arrSource1(lLowSource1D1, I)), _
SZ_VARIANT * ((lIndex - lLowSource1D1))
Next I
'Append array arrSource2 to arrDestination at lIndex
For I = LBound(arrSource1, 2) To UBound(arrSource1, 2) 'Copy columns
CopyMemory ByVal VarPtr(out(lIndex, I)), _
ByVal VarPtr(arrSource2(LBound(arrSource2), I)), _
SZ_VARIANT * (lHighSource2D1 - lLowSource2D1 + 1)
Next I
If UBound(arrSource1, 1) >= lIndex Then 'the rest
For I = LBound(arrSource1, 2) To UBound(arrSource1, 2) 'Copy columns
CopyMemory ByVal VarPtr(out(lIndex + (lHighSource2D1 - lLowSource2D1 + 1), I)), _
ByVal VarPtr(arrSource1(lIndex, I)), _
SZ_VARIANT * (UBound(arrSource1) - lIndex + 1)
Next I
End If
'Return array after deleting
InsertElementArray2D = out

'Erase source array in memory
For I = LBound(arrSource1, 2) To UBound(arrSource1, 2)
ZeroMemory ByVal VarPtr(arrSource1(lLowSource1D1, I)), _
SZ_VARIANT * (UBound(arrSource1) - lLowSource1D1 + 1)
Next I
Erase arrSource1
For I = LBound(arrSource2, 2) To UBound(arrSource2, 2)
ZeroMemory ByVal VarPtr(arrSource2(lLowSource1D1, I)), _
SZ_VARIANT * (UBound(arrSource2) - lLowSource2D1 + 1)
Next I
Erase arrSource2
End Function

Function ConvertArray1DTo2D(ByVal arrSource As Variant) As Variant
'Programming by: Nguyen Duy Tuan - www.bluesofts.net
'arrSource: is array 1D. Elements of array with VARIANT type
'Return: an array 2D. Elements of array with VARIANT type
'Use this function to fill array 1D to range in 1 column
'If arrSource is array 1D, ConvertArray1DTo2D() is better Application.WorksheetFunction.Transpose() for large array
Dim I As Long, lLowArray As Long

lLowArray = LBound(arrSource, 1)
ReDim out(lLowArray To UBound(arrSource, 1), 1 To 1) As Variant

CopyMemory ByVal VarPtr(out(lLowArray, 1)), _
ByVal VarPtr(arrSource(lLowArray)), _
SZ_VARIANT * (UBound(arrSource) - lLowArray + 1)
'Return array 2D
ConvertArray1DTo2D = out

'Erase source array in memory
ZeroMemory ByVal VarPtr(arrSource(lLowArray)), _
SZ_VARIANT * (UBound(arrSource) - lLowArray + 1)
Erase arrSource
End Function[/GPECODE]

Bộ hàm trên tương thích với các môi trường Windows , Office 32 và 64-bit.

Hy vọng bộ hàm này giúp ích được các bạn khi xây dựng ứng dụng với tốc độ chạy nhanh. Rất mong các bạn góp ý thêm để bộ hàm được hoàn thiện hơn.

Tôi thấy nghi vấn một vấn đề. Xin trình bầy để mọi người cùng góp ý kiến.
Theo tôi thì có "rò rỉ bộ nhớ".

Vấn đề là chung nhưng tôi xét cụ thể hàm DeleteElementArray2D để dễ trình bầy. Ta xét sub TestDeleteArray2D.

a. Trước tiên ta có mảng source. Mỗi một phần tử của mảng là Variant, chiếm 16 bai bộ nhớ. Trong 8 bai đầu được ghi VarType. Do các phần tử của mảng source là String nên trong 8 bai đầu được ghi giá trị 8 (VarType = 8 = vbString). Trong 8 bai sau được ghi data. Tức nếu phần tử của mảng là numeric (<= 8 bai) thì giá trị trong 8 bai thứ 2 chính là giá trị numeric. Nếu phần tử của mảng là Object thì trong 8 bai sau ta có Pointer (4 bai) tới Object nằm ở nơi khác trong bộ nhớ. Nếu phần tử của mảng là String thì trong 8 bai sau ta có Pointer (4 bai) tới String được ghi ở chỗ khác trong bộ nhớ (thì trong 8 bai làm sao ghi được String với độ dài bất kỳ)

Tóm lại trong th mảng source ta có 2 vùng bộ nhớ: vùng 1 - ta gọi tắt là source1 - là vùng ghi mảng source, và 4004 String được ghi ở vùng 2 - ta gọi tắt là source2. 4004 Pointer tới 4004 string này được ghi ở 4004 cụm 8 bai thứ hai của 4004 Variant có trong mảng source nằm ở vùng 1 - source1.

b. Do trong sub TestDeleteArray2D ta gọi hàm DeleteElementArray2D và ta truyền source bởi BYVAL nên trong bộ nhớ một bản sao của source được tạo ra và bản sao này được truyền vào DeleteElementArray2D. Bản sao này sử dụng arrSource1 <> source1 và arrSource2 <> source2. Tới lúc này ta có trong bộ nhớ 4 vùng: source1, source2, arrSource1, arrSource2.

c. Ở thời điểm

ReDim out(lLowArrayD1 To UBound(arrSource, 1) - (lIndexEnd - lIndexBegin + 1), _
              lLowArrayD2 To UBound(arrSource, 2)) As Variant

thì code "đặt đơn" xin system bộ nhớ để ghi mảng out, tức xin vùng out1.
Do ta dùng CopyMemory để chuyển các bai từ mảng arrSource sang mảng out nên các Pointer (nằm trong 8 bai thứ hai của Variant) tới các String trong arrSource được sao sang mảng out. Như vậy out2 không được tạo ra mà các Pointer tới các String ở arrSource và ở out đều trỏ tới arrSource2.
Cũng chính vì lý do trên mà ở cuối hàm DeleteElementArray2D ta không có đơn giản là Erase arrSource - vì lúc đó vùng arrSource2 sẽ được giải phóng, và các Pointer trong out sẽ trỏ tới vùng arrSource2 đã được giải phóng. Hậu quả là khi ra khỏi hàm và là lúc out được giải phóng thì Memory Manager sẽ "cố" giải phóng arrSource2 (do các Pointer trong out trỏ tới), tức ta sẽ có access violation. Vì thế mà ta có:

For I = LBound(arrSource, 2) To UBound(arrSource, 2)
        ZeroMemory ByVal VarPtr(arrSource(lLowArrayD1, I)), SZ_VARIANT * (UBound(arrSource) - lLowArrayD1 + 1)
    Next I
    Erase arrSource

Tức trước tiên ta gọi ZeroMemory. Hậu quả là địa chỉ tới các String nằm ở vùng arrSource2 bị xóa. Sau đó thì Erase không còn có các địa chỉ này để giải phóng vùng arrSource2. Mà như đã chỉ ở trên thì ta không thể xóa toàn bộ vùng arrSource2 được vì các Pointer trong out trỏ tới chúng. Nếu muốn - và thực ra là cần phải - giải phóng một phần vùng arrSource2 chiếm bới các String của các dòng được xóa (do vậy không dùng trong out), tức các dòng từ 3 tới 9 - tổng cộng là 28 String. Tóm lại Erase arrSource chỉ giải phóng arrSource1 là vùng chiếm bởi bản thân mảng arrSource mà thôi.

d. Ở thời điểm khi hàm DeleteElementArray2D trở về thì trong bộ nhớ ta có source1, source2, arrSource2, Dest1, Dest2.

Ở cuối sub TestDeleteArray2D ta có:

[

    Erase source
    Erase Dest

tức source1, source2, Dest1, Dest2 được giải phóng.

Còn arrSource2 không được giải phóng. Bây giờ có muốn giải phóng arrSource2 cũng không thể vì không còn địa chỉ của các String nữa. Các bạn không rành về lập trình thì hãy tưởng tượng thế này. Khi ta xây 1 căn nhà (ghi String vào vùng arrSource2) thì ta ghi địa chỉ của căn nhà đó vào sổ tay (ghi địa chỉ của String nằm ở vùng arrSource2 vào cụm 8 bai thứ hai của Variant là phần tử của mảng arrSouce - Variant nằm ở vùng arrSource1). Khi cần giải phóng mặt bằng, tức "Phá căn nhà" (Erase arrSource) thì ta đọc địa chỉ của căn nhà đã ghi trong sổ tay (đọc địa chỉ của String từ 8 bai thứ hai của Variant) --> điều máy ủi tới địa chỉ đã đọc và san bằng (có địa chỉ trong arrSource2 thì giải phóng bộ nhớ đó). Nhưng nếu ta lỡ xóa mất địa chỉ trong sổ tay (xóa các địa chỉ của các String nằm trong vùng arrSource2 - các đa chỉ này được ghi ở 8 bai thứ hai của Variant) thì cử máy ủi đi đâu để mà giải phóng mặt bằng (giải phóng arrSource2 bằng cách nào)?

Nếu tính chi li thì ta chỉ mất địa chỉ của 28 String vì địa chỉ của 4004 - 28 = 3976 String còn lại ta vẫn có trong out. Khi ra khỏi hàm DeleteElementArray2D thì out được giải phóng nên 3976 String cũng được giải phóng.
Nhưng nếu ta có 1001 dòng mà ta lại xóa 1000 dòng thì có 4*1000 String không được giải phóng.

Các bạn xem tôi có nhầm lẫn chỗ nào hay không.

 

[Nguyễn Duy Tuân]

Cảm ơn anh siwtom có những phân tích tương đối chi tiết. Em sẽ kiểm tra lại vấn đề chiếm dụng và giải phóng bộ nhớ của mảng kỹ thêm. Hôm nay 8/3 muốn ngồi máy cũng không được rồi, vợ kill me mất.

 

[siwtom]

Tôi thấy nghi vấn một vấn đề. Xin trình bầy để mọi người cùng góp ý kiến.
Theo tôi thì có "rò rỉ bộ nhớ".

...
Các bạn xem tôi có nhầm lẫn chỗ nào hay không.

Ngồi buồn tôi thực hiện vài test.
Tôi thêm 3 sub/function như sau:

[GPECODE=vb]
Sub TestDeleteElementArray2D()
Dim X As Long, Y As Long, Dest As Variant, k As Long, t As Double

For k = 1 To 100

t = GetTickCount

ReDim source(0 To 60000, 0 To 3) As Variant

For X = 0 To 3
For Y = 0 To 60000
source(Y, X) = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ " & Y & X
Next Y
Next X

Dest = DeleteElementArray2D(source, 10, 59990)

Erase source
Erase Dest

Debug.Print "vong " & k & " - " & (GetTickCount - t) / 1000
Next k
End Sub

Function DeleteElementArray2DFor(ByVal arrSource As Variant, ByVal lIndexBegin As Long, ByVal lIndexEnd As Long) As Variant
'arrSource: is array 2D. Elements of array with VARIANT type
'Return: an array after deleting element from lIndexBegin to lIndexEnd. Elements of array with VARIANT type
Dim I As Long, lLowArrayD1 As Long, lLowArrayD2 As Integer, r As Long

lLowArrayD1 = LBound(arrSource, 1)
lLowArrayD2 = LBound(arrSource, 2)
'Check Parameters valid
If (lIndexEnd < lLowArrayD1) Or (lIndexEnd > UBound(arrSource, 1)) Then
lIndexEnd = UBound(arrSource, 1)
End If
If lIndexBegin < lLowArrayD1 Then
Err.Raise 10000, "DeleteElementArray2D", "Parameter lIndexBegin is invalid."
End If
If lIndexBegin > lIndexEnd Then
Err.Raise 10001, "DeleteElementArray2D", "You must ensure that lIndexBegin <= lIndexEnd."
End If

ReDim out(lLowArrayD1 To UBound(arrSource, 1) - (lIndexEnd - lIndexBegin + 1), _
lLowArrayD2 To UBound(arrSource, 2)) As Variant

For r = lLowArrayD1 To lIndexBegin - 1
For I = LBound(arrSource, 2) To UBound(arrSource, 2)
out(r, I) = arrSource(r, I)
Next I
Next r

For r = lIndexEnd + 1 To UBound(arrSource)
For I = LBound(arrSource, 2) To UBound(arrSource, 2)
out(r - (lIndexEnd - lIndexBegin + 1), I) = arrSource(r, I)
Next I
Next r

'Return array after deleting
DeleteElementArray2DFor = out
End Function

Sub TestDeleteElementArray2DFor()
Dim X As Long, Y As Long, Dest As Variant, k As Long, t As Double

For k = 1 To 100

t = GetTickCount

ReDim source(0 To 60000, 0 To 3) As Variant

For X = 0 To 3
For Y = 0 To 60000
source(Y, X) = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ " & Y & X
Next Y
Next X

Dest = DeleteElementArray2DFor(source, 10, 59990)

Erase source
Erase Dest

Debug.Print "vong " & k & " - " & (GetTickCount - t) / 1000
Next k
End Sub
[/GPECODE]

Như đã thấy tôi tạo thêm hàm DeleteElementArray2DFor. Hàm DeleteElementArray2DFor được tạo từ hàm DeleteElementArray2D bằng cách thay 2 vòng FOR dùng CopyMemory bằng 2 vòng FOR "bình thường", và bỏ ZeroMemory + Erase arrSource

Hai SUB test là "y hệt" tới 99,99%. Chỉ khác nhau là 1 test gọi hàm DeleteElementArray2D còn test kia gọi hàm DeleteElementArray2DFor

Tôi test bằng cách: cứ mỗi lần test xong thì đóng Excel rồi mở lại thì mới test lần tiếp theo. Làm như thế để các lần test có môi trường như nhau.

Tôi test mỗi kiểu 3 lần. Mỗi lần test là thực hiện FOR với 100 vòng lặp. Kết quả:

1. TestDeleteElementArray2D - test hàm DeleteElementArray2D
Có 2 lần vòng lặp thực hiện được 53 vòng, có 1 lần thực hiện tới vòng 51 thì "out of memory"
View attachment 98116
View attachment 98113

Thời gian thực hiện các vòng lặp là:
vong 1 - 1,112 vong 2 - 1,221 vong 3 - 1,202 vong 4 - 1,162 vong 5 - 1,171
vong 6 - 1,152 vong 7 - 1,152 vong 8 - 1,171 vong 9 - 1,182 vong 10 - 1,162
vong 11 - 1,262 vong 12 - 1,261 vong 13 - 1,262 vong 14 - 1,272 vong 15 - 1,262
vong 16 - 1,272 vong 17 - 1,272 vong 18 - 1,261 vong 19 - 1,262 vong 20 - 1,272
vong 21 - 1,272 vong 22 - 1,272 vong 23 - 1,292 vong 24 - 1,462 vong 25 - 3,205
vong 26 - 4,316 vong 27 - 4,426 vong 28 - 4,366 vong 29 - 3,896 vong 30 - 4,356
vong 31 - 3,855 vong 32 - 3,696 vong 33 - 4,867 vong 34 - 6,609 vong 35 - 5,718
vong 36 - 4,276 vong 37 - 4,576 vong 38 - 5,838 vong 39 - 4,847 vong 40 - 5,028
vong 41 - 4,386 vong 42 - 4,276 vong 43 - 4,877 vong 44 - 5,157 vong 45 - 5,498
vong 46 - 4,286 vong 47 - 4,066 vong 48 - 4,396 vong 49 - 4,546 vong 50 - 6,229
vong 51 - 4,857
----------------

2. TestDeleteElementArray2DFor - test hàm DeleteElementArray2DFor
Luôn thực hiện đủ 100 vòng lặp mà không có "out of memory".
View attachment 98117
View attachment 98114

Thời gian thực hiện các vòng lặp gần như là đều nhau:
vong 1 - 1,282 vong 2 - 1,332 vong 3 - 1,362 vong 4 - 1,402 vong 5 - 1,412
vong 6 - 1,372 vong 7 - 1,402 vong 8 - 1,352 vong 9 - 1,412 vong 10 - 1,452
vong 11 - 1,482 vong 12 - 1,563 vong 13 - 1,492 vong 14 - 1,552 vong 15 - 1,522
vong 16 - 1,552 vong 17 - 1,503 vong 18 - 1,512 vong 19 - 1,542 vong 20 - 1,542
vong 21 - 1,542 vong 22 - 1,523 vong 23 - 1,632 vong 24 - 1,502 vong 25 - 1,552
vong 26 - 1,553 vong 27 - 1,622 vong 28 - 1,562 vong 29 - 1,633 vong 30 - 1,552
vong 31 - 1,542 vong 32 - 1,592 vong 33 - 1,503 vong 34 - 1,602 vong 35 - 1,622
vong 36 - 1,552 vong 37 - 1,603 vong 38 - 1,622 vong 39 - 1,642 vong 40 - 1,603
vong 41 - 1,652 vong 42 - 1,602 vong 43 - 1,633 vong 44 - 1,592 vong 45 - 1,652
vong 46 - 1,603 vong 47 - 1,602 vong 48 - 1,672 vong 49 - 1,593 vong 50 - 1,602
vong 51 - 1,642 vong 52 - 1,553 vong 53 - 1,682 vong 54 - 1,663 vong 55 - 1,682
vong 56 - 1,652 vong 57 - 1,683 vong 58 - 1,652 vong 59 - 1,683 vong 60 - 1,702
vong 61 - 1,652 vong 62 - 1,663 vong 63 - 1,652 vong 64 - 1,652 vong 65 - 1,653
vong 66 - 1,622 vong 67 - 1,643 vong 68 - 1,652 vong 69 - 1,652 vong 70 - 1,693
vong 71 - 1,652 vong 72 - 1,653 vong 73 - 1,652 vong 74 - 1,652 vong 75 - 1,643
vong 76 - 1,672 vong 77 - 1,652 vong 78 - 1,693 vong 79 - 1,642 vong 80 - 1,633
vong 81 - 1,612 vong 82 - 1,702 vong 83 - 1,643 vong 84 - 1,682 vong 85 - 1,653
vong 86 - 1,712 vong 87 - 1,622 vong 88 - 1,653 vong 89 - 1,702 vong 90 - 1,713
vong 91 - 1,652 vong 92 - 1,692 vong 93 - 1,643 vong 94 - 1,702 vong 95 - 1,653
vong 96 - 1,662 vong 97 - 1,652 vong 98 - 1,713 vong 99 - 1,622 vong 100 - 1,633
-------------

Tất nhiên trên máy khác "out of memory" có thể sẩy ra ở những vòng lặp sau. Nó phụ thuộc vào máy. Máy tôi đĩa cứng C chỉ có 2,73 GB trống (tổng cộng C chỉ có ~ 10 GB), 1488 MB swap file, tổng cộng 1 GB RAM.
Nếu máy mạnh thì có thể tăng số vòng lặp lên 200, 300 và xem khi nào có "out of memory".

Mọi người rỗi thử test xem nhé

 

[Nguyễn Duy Tuân]

Phiên bản mới FastArray v1.1

Thông báo các thành viên phiên bản mới FastArray 1.1 - Updated: 10-Mar-2013

Các nâng cấp và thêm mới:

Thêm các hàm
+ DeleteColumnArray2D - Cho phép xóa các cột liên tiếp trong một mảng 2 chiều
+ InsertColumnArray2D - Cho phép chèn các cột từ hai mảng 2 chiều (2D) khác nhau chèn lồng vào nhau.
+ Sửa: sửa cấu trúc hàm, hàm không nhận mảng trả vể, mảng trả về qua một tham số đầu tiên là mảng arrDest(). Các hàm đều là kiểu Boolean.
+ Sửa: sửa lỗi tràn bộ nhớ do không giải phóng bộ nhớ của các phần tử xóa khỏi mảng. Cảm ơn anh siwtom đã phát hiện ra lỗi này.
+ Tốc độ các hàm chạy nhanh hơn phiên bản cũ.

Toàn bộ mã nguồn được cập nhật tại trang đầu tiên. Các thành viên có thể download về chạy thử. Trong file đã bổ sung sheet "Compare" để tiện cho việc test và so sánh giữa các phương pháp vòng lặp FOR..NEXT và phương pháp MEMORY của module này.

Khi số phần tử mảng thấp <100.000 dòng, 4 cột thì tốc độ không đáng kể lắm, nhưng khi test với mảng >100.000 dòng và 4 cột thì sự khác nhau là nhiều, khác nhau cả vấn đề chiếm dụng bộ nhớ nữa. Phương pháp vòng lặp, xóa càng ít phần tử chạy càng chậm hơn là xóa nhiều. Khi test các hàm loại "Delete*" thì số phần tử xóa khỏi mảng cũng ảnh hưởng tới cả hai phương pháp. Trong quá trình kiểm tra phiên bản mới (FastArray v1.1) tôi kết luận phương pháp MEMORY là tốt hơn dùng vòng lặp. Có thể bài sau tôi sẽ trình bày việc test như thế nào.

Rất mong các bạn tiếp tục góp ý để bộ hàm trong module "modFastArray" được hoàn thiện hơn.

 

[Nguyễn Duy Tuân]

Phiên bản mới FastArray v1.1 vơi các thử nghiệm FOR & MEMORY

Nhận xét về kết quả test trên phiên bản FastArray v1.1:

Thử nghiệm 3 lần với cả 2 phương pháp FOR..NEXT, MEMORY(FastArray). Trước mỗi phương pháp đều thoát Excel rồi mở lại để đảm bảo lần test tiếp theo có môi trường ban đầu như nhau.

Thử nghiệm trên Windows Vista 32-bit (Intel Core 2 Duo CPU 2.00 GHz, RAM 3.00 GB) , Excel 2010 32-bit

Thực hiện việc xóa 60,000 dòng trong mảng có 400,000 dòng và 4 cột.

+ Tốc độ: Thời gian thực hiện của FOR..NEXT là 39.843 giây (3.98 giây/1 vòng lặp). Phương pháp MEMORY (FastArray) thì thời gian thực hiện là 4.43 (0.04 giây/1 vòng lặp). Vậy FOR..NEXT bị chậm hơn MEMORY là 35.41 giây. Thực hiện thêm lần 2, lần 3 kêt quả gần như nhau.

+ Bộ nhớ bị chiếm dụng: Tạm dùng công cụ "Windows Task Manager" để quan sát. Phương pháp FOR..NEXT chưa giải phóng hết 97,636 KB. Phương pháp MEMORY thì còn 29,012 KB chưa giải phóng hết. Như vậy FOR chiếm dụng nhiều hơn MEM là 68,624 KB. Thử nghiệm các lần tiếp theo kết quả gần như nhau.

+ Sự ổn định về tốc độ: Tạm dùng hàm STDEVA để tính độ lệch chuẩn - đo mức độ sai lệch thời gian trung bình của 10 vòng lặp với thời gian trung bình của chúng.
FOR là 0.1599, MEM là 0.01, các lần thử tiếp theo kết quả gần như nhau. Như vậy vòng lặp FOR tốc độ không ổn định bằng MEMORY. Có thể trong mỗi vòng lặp nó chịu sự tác động của các yếu tốt khác thay đổi trong hệ thống.

Thử nghiệm 3 lần với cả 2 phương pháp. Thực hiện việc xóa 1,000 dòng trong mảng có 400,000 dòng và 4 cột.

Tốc độ của FOR bị chậm hơn khi xóa 60,000 dòng. MEM vẫn gần như vậy.
Về bộ nhớ thì FOR chiếm dụng bộ nhớ nhiều hơn khi xóa 60,000 dòng, MEM thì vẫn gần như nhau.
Tính ổn định vẫn như với việc xóa 60,000 dòng.

Tại sao có sự thay đổi của phương pháp FOR khi giảm số dòng xóa từ 60,000 xuống còn 1000?

Theo phương pháp FOR thì nó thực hiện vòng lặp để chỉ nhặt ra những phần tử không bị xóa. Nên nếu số phần tử cần xóa mà ít thì công việc "nhặt thóc" càng nhiều, bộ nhớ bị chiếm dụng tăng lên cũng có thể từ lý do có thêm vùng chứa dữ liệu. Nếu dùng FOR để xóa 390,000 trong số 400,000 dòng thì chắc rất nhanh vì việc của nó chỉ phải nhặt ra 10,000 thôi.

Theo phương pháp MEMORY thì dù xóa nhiều hay ít thì thì thời gian vẫn như nhau. Vì bản chất công việc của nó là chuyển dịch lại vùng nhớ, bê những vùng nhớ cần trả về sang một bên, vùng nhớ cần xóa sang một bên để giải phóng. Việc chuyển dịch các byte trong bộ nhớ bằng một vài lần của lệnh CopyMemory sẽ ít chịu ảnh hưởng của các biến động nào đó trong hệ thống, điều này không như FOR phải thực hiện số lần lặp gần như bằng với số phần tử của mảng (tùy vào số lượng phần tử xóa trong mảng).

Thử nghiệm trên máy ảo (VMWare), Windows 7 64-bit (Intel Core 2 Duo CPU 2.00 GHz, RAM 1.00 GB) , Excel 2013 64-bit

Lần thử nghiệm này để kiểm tra với hệ thống phần cứng thấp hơn, nền tảng tính toán khác thì thay đổi thế nào?

Có 2 kịch bản test:
+ Số dòng xóa giảm còn 1,000 số dòng của mảng 100,000 cố tạo ưu thế cho FOR (giảm số vòng lặp). Nhận xét về cơ bản vẫn như với trường hợp chạy môi trường 32-bit. Và MEM vẫn nhanh hơn FOR.

+ Số dòng xóa 1,000 số dòng của mảng 400,000 giống với thực hiện hở 32-bit. FOR..NEXT chạy quá chậm, tổng thời gian thực hiện 10 vòng lặp là 1,976.67 giây ~ 32.9 phút. Còn MEMORY là 11.296 giây ~ 0.2 phút nhanh hơn FOR rất nhiều. Trong tính huống này thì sự ổn định MEMORY gấp ~10 lần so với FOR. Chính tỏ tốc độ của FOR..NEXT chịu ảnh hưởng rất lớn của phần cứng và phần mềm máy tính. Còn MEMORY vẫn như người đi dưới hầm dù trời gió to !?.

Về vấn đề giải phóng bộ nhớ thì Excel có vẻ không làm tốt việc này như chúng ta nghĩ, trong quá trình ghi chép dữ liệu và làm lâu lâu dẫn đên bộ nhớ tăng lên không giảm được. Chúng ta như chỉ có thể làm tốt tối đa về mặt lý thuyết !?.

Với số phần tử mảng ít <60,000 dòng & 4 cột thì tốc độ giữa 2 phương pháp FOR và MEM không khác mấy nhưng MEM có vẻ vẫn làm tốt hơn về mặt giải phóng bộ nhớ. Cũng có thể hàm Delete..For sửa lại cách viết thì sẽ được cải thiện hơn. Khi mảng lớn (số dòng> 100,000 dòng & > 4 cột) thì MEMORY ưu thế hơn nhiều FOR cả về tốc độ, bộ nhớ và tính ổn định.

Các phân tích trên tôi dựa vào việc làm với số lượng phần tử mảng tương đối lớn, và với vài cấu hình phần cứng và phần mềm khác nhau nên tạm kết luận như trên. Các bạn quan tâm và có điều kiện có thể kiểm tra thêm xem thế nào nhé.

Phiên bản mới FastArray v1.1 tại trang đầu.

 

[siwtom]

Rất mong các bạn tiếp tục góp ý để bộ hàm trong module "modFastArray" được hoàn thiện hơn.

Code ngày càng nhiều nên ngại xem quá. Tôi chỉ nhìn qua hàm DeleteElementArray2D và tin là ổn.
Tôi chỉ muốn xét thêm 2 điểm, gọi là cùng bàn với nhau:

1. Khi hàm được gọi thì khi hàm trở về thì mảng nguồn Source không còn nữa. Như vậy nếu ta muốn từ 1 mảng nguồn trích ra 2 mảng con thì không làm được. Vấn đề này có lẽ không khắc phục được.
Nhưng liệu nhu cầu trích ra >= 2 mảng con từ một mảng nguồn có cao không? Hoặc nhu cầu vẫn cần có mảng nguồn sau khi trích ra MỘT mảng con có cao không?

2. Theo tôi biết thì mảng trong Delphi được ghi trong bộ nhớ bằng các DÒNG lần lượt một cách LIÊN TỤC. Và mảng trong VBA được ghi trong bộ nhớ bằng các CỘT lần lượt một cách LIÊN TỤC.
Vậy thì trong việc xóa một cụm cột hoặc thêm 1 cụm cột ta có thể thay nhiều lần gọi CopyMemory bằng nhiều nhất là 2 lần gọi CopyMemory.
Chỉ có điều số cột thường không nhiều nên có làm như thế thì cũng chả "tiết kiệm" được là bao. Vậy có đáng không?

 

[Hoàng Trọng Nghĩa]

Tôi thấy Hàm Insert cũng là hàm nối mảng với mảng nó rất hay! Đặc biệt, cho dù mảng nguồn ban đầu có 1001 dòng nhưng khi ta đặt vị trí insert là 2000 đi chăng nữa thì kết quả nó vẫn không lỗi mà còn liên tục từ dòng thứ 1002.

 

[Nguyễn Duy Tuân]

Code ngày càng nhiều nên ngại xem quá. Tôi chỉ nhìn qua hàm DeleteElementArray2D và tin là ổn.
Tôi chỉ muốn xét thêm 2 điểm, gọi là cùng bàn với nhau:

1. Khi hàm được gọi thì khi hàm trở về thì mảng nguồn Source không còn nữa. Như vậy nếu ta muốn từ 1 mảng nguồn trích ra 2 mảng con thì không làm được. Vấn đề này có lẽ không khắc phục được.
Nhưng liệu nhu cầu trích ra >= 2 mảng con từ một mảng nguồn có cao không? Hoặc nhu cầu vẫn cần có mảng nguồn sau khi trích ra MỘT mảng con có cao không?

Nhu cầu cần có mảng mới sau khi xóa hay chèn thêm các phần tử trong mảng thường để dùng cho công việc tiếp theo có thể là nhiều, còn giữ lại mảng cũ cũng có nhưng có thể không nhiều (chủ quan).

Nếu cần giữ lại mảng Source, thì có 2 cách:
+ Sửa lại mã nguồn khai báo tham số của hàm Byref arrSource thành ->Byval arrSource. Chỉ là cách thôi chứ không nên làm thế vì tốc độ chạy chậm, nhu cầu lại không thường xuyên.
+ Khi không sửa lại mã nguồn các hàm trong module modFastArray thì sẽ viết một hàm như là CopyArray(Dest, Source) hoặc CloneArray(Dest, Source) để dùng trong những trường hợp trên. Hàm dạng CopyArray có lẽ phải dùng vòng lặp.

2. Theo tôi biết thì mảng trong Delphi được ghi trong bộ nhớ bằng các DÒNG lần lượt một cách LIÊN TỤC. Và mảng trong VBA được ghi trong bộ nhớ bằng các CỘT lần lượt một cách LIÊN TỤC.
Vậy thì trong việc xóa một cụm cột hoặc thêm 1 cụm cột ta có thể thay nhiều lần gọi CopyMemory bằng nhiều nhất là 2 lần gọi CopyMemory.
Chỉ có điều số cột thường không nhiều nên có làm như thế thì cũng chả "tiết kiệm" được là bao. Vậy có đáng không?

Các hàm trong module modFastArray ngoài đảm nhiệm tôc độ nhanh thì còn là bộ hàm tiện dụng, sẵn để dùng cho nhu cầu đặc biệt. Về ứng dụng các hàm xóa, thêm các dòng, xóa, thêm các cột trong các hoàn cảnh thế nào thì ta chưa tưởng tượng hết được. Nghĩ qua trong đầu một ví dụ về xử lý cột là: Vùng danh mục khách hàng có 6 cột, cần đưa lên ListBox, ComboBox danh mục này, trong VBA thường dùng:

[GPECODE=vb] Dim Source
Source = Range("DMKH").Value
ListBox1.ColumnCount = UBound(Source, 2) - LBound(Source, 2) + 1
ListBox1.List = Source
[/GPECODE]
Nhưng khi ta cần chỉ lấy các cột 1,2,5,6 (không có 3,4) thì là như sau:

[GPECODE=vb] Dim Source, Dest()
Source = Range("DMKH").Value
DeleteColumnArray2D Dest, Source, 3, 4 'Xoá cột 3,4
ListBox1.ColumnCount = UBound(Dest, 2) - LBound(Dest, 2) + 1
ListBox1.List = Dest
[/GPECODE]

Nếu người dùng có một cột về về số dư nợ cuối kỳ của từng khách hàng, cần đưa lên báo cáo hoặc ListBox, ComboBox gồm thông tin trong danh mục và số dư nợ cuối kỳ từng người tức là ghép 2 vùng lại với nhau (với điều kiện từng dòng ứng với từng khách hàng).

Ta làm như sau:
[GPECODE=vb] Dim Source, SourceBalance, Dest()
Source = Range("DMKH").Value
SourceBalance = Range("Số dư nợ").Value
InsertColumnArray2D Dest, Source, -1, SourceBalance 'Chèn các cột trong mảng SourceBalance vào cuối cac cột của mảng Source, kết quả trả về mảng Dest
ListBox1.ColumnCount = UBound(Dest, 2) - LBound(Dest, 2) + 1
ListBox1.List = Dest
[/GPECODE]

Nếu điền mảng Dest trên vào ô nào đó như là A4 thì chỉ cần

[GPECODE=vb]FillToRange Range("A4"), Dest[/GPECODE]

Hai hàm trong ví dụ trên InsertColumnArray2D, DeleteColumnArray2D có trong phiên bản FastArray v1.1.

Thực ra còn nhiều tình huống ứng dụng mà ta chưa tưởng tượng hết. Nhưng dùng các hàm trong modFasrArray tôi tin là ta được tốc độ và sự tiện dụng cao.

 

[siwtom]

Tôi thấy Hàm Insert cũng là hàm nối mảng với mảng nó rất hay! Đặc biệt, cho dù mảng nguồn ban đầu có 1001 dòng nhưng khi ta đặt vị trí insert là 2000 đi chăng nữa thì kết quả nó vẫn không lỗi mà còn liên tục từ dòng thứ 1002.

Thế bạn ngạc nhiên quá à? Thì bạn không hiểu nên ngạc nhiên thôi.

Chuyện kiểm tra dữ liệu đầu vào là chuyện phải có. Tuân lập trình chuyên nghiệp nên Tuân phục vụ các tình huống lỗi là đương nhiên

Bạn có hiểu

If lIndex < lLowSource1D1 Or lIndex > UBound(arrSource1) Then
        lIndex = UBound(arrSource1) + 1 'insert array at the end of arrSource1 array
    End If

làm gì không? Là để cho "kết quả nó vẫn không lỗi"

Còn chuyện liên tục thì tôi không hiểu. "mà còn liên tục từ dòng thứ 1002" có nghĩa là gì?. Một khi đã REDIM tức có một mảng được tạo ra trong bộ nhớ. Nó có bằng ấy bằng ấy dòng và cột, và được ghi bằng các cột LIÊN TIẾP một cách LIÊN TỤC trong bộ nhớ.

Ta xét mảng có 1001 dòng (từ 1 tới 1001) và ta muốn insert mảng có vd. a dòng (a >= 1) vào vị trị 2000.

Ở thời điểm thực hiện code trong InsertElementArray2D

ReDim arrDest(lLowSource1D1 To UBound(arrSource1, 1) + (lHighSource2D1 - lLowSource2D1 + 1), _
              lLowSource1D2 To UBound(arrSource1, 2)) As Variant

thì 1 mảng sẽ được tạo ra trong bộ nhớ. Nó có tổng cộng số dòng là 1001 + a >= 1002 (tổng quát là số dòng mảng 1 + số dòng mảng 2)

Do lIndex = 2000 > 1001 = UBound(arrSource1) nên sau khi thực hiện code

If lIndex < lLowSource1D1 Or lIndex > UBound(arrSource1) Then
        lIndex = UBound(arrSource1) + 1 'insert array at the end of arrSource1 array
    End If

thì lIndex = 1002. Tức mảng có a phần tử được nối vào "đuôi" mảng nguồn, ở vị trí dòng 1002. Thế thôi chứ đâu có phép mầu nhiệm gì ở đây?
-------------
Tất nhiên nếu có nhu cầu thì cũng có thể viết code sao cho nếu lIndex > UBound(arrSource1) thì REDIM sao cho mảng có (số dòng mảng 1 + số dòng mảng 2 + (lIndex - UBound(arrSource1) - 1)) dòng.
Trong th trên thì ghi lần lượt các dòng của mảng 1 rồi ghi tiếp các dòng của mảng 2 bắt đầu từ index = lIndex. Tức trong mảng trả về có (lIndex - UBound(arrSource1) - 1) dòng trống, bắt đầu từ dòng thứ (UBound(arrSource1) + 1) tới (lIndex - 1).

Như vậy chuyện viết code như thế nào là do nhu cầu. Chả có phép mầu nhiệm gì ở đây.
---------------
Những cái quí trong code của Tuân là: hiểu được ý nghĩa của các bai trong mỗi Variant, thao tác với các khối bộ nhớ dùng CopyMemory, hiểu được cách mà mảng được ghi trong bộ nhớ (Tuân đọc từng cột do mảng trong VBA được ghi bằng các cột liên tiếp), và xử lý giải phóng bộ nhớ. Mọi cái khác - IF, FOR, REDIM - thậm chí cả thuật toán Insert nếu bạn hết choáng thì bạn cũng viết được. Tất nhiên những cái tôi liệt kê là 99,9% công việc. Những cái khác chỉ là râu ria thêm thôi.

 

[thanhtratt]

Cám ơn anh đã viết các hàm rất hay.
Anh cho em hỏi hàm ConvertArray1DTo2D có thể chuyển mảng ngược từ ODA thành mảng xuôi được không anh?
Anh có thể bổ sung thêm hàm chuyển mảng ngược thành xuôi và hàm chuyển mảng bắt đầu từ phần tử 0 thành mảng bắt đầu từ phần 1 không anh?
Cám ơn anh!

 

[Hoàng Trọng Nghĩa]

Code ngày càng nhiều nên ngại xem quá. Tôi chỉ nhìn qua hàm DeleteElementArray2D và tin là ổn.
Tôi chỉ muốn xét thêm 2 điểm, gọi là cùng bàn với nhau:

1. Khi hàm được gọi thì khi hàm trở về thì mảng nguồn Source không còn nữa. Như vậy nếu ta muốn từ 1 mảng nguồn trích ra 2 mảng con thì không làm được. Vấn đề này có lẽ không khắc phục được.
Nhưng liệu nhu cầu trích ra >= 2 mảng con từ một mảng nguồn có cao không? Hoặc nhu cầu vẫn cần có mảng nguồn sau khi trích ra MỘT mảng con có cao không?

2. Theo tôi biết thì mảng trong Delphi được ghi trong bộ nhớ bằng các DÒNG lần lượt một cách LIÊN TỤC. Và mảng trong VBA được ghi trong bộ nhớ bằng các CỘT lần lượt một cách LIÊN TỤC.
Vậy thì trong việc xóa một cụm cột hoặc thêm 1 cụm cột ta có thể thay nhiều lần gọi CopyMemory bằng nhiều nhất là 2 lần gọi CopyMemory.
Chỉ có điều số cột thường không nhiều nên có làm như thế thì cũng chả "tiết kiệm" được là bao. Vậy có đáng không?

Ý của em cũng khá giống như Thầy, tuy nhiên thay vì phải cho ra mảng Dest, thì mảng Source ban đầu chính là mảng Dest khi ra kết quả. Có nghĩa là không có mảng Dest.

Thay vì:

Function DeleteElementArray2D([COLOR=#ff0000]ByRef arrDest() As Variant[/COLOR], ByRef arrSource As Variant, ByVal lIndexBegin As Long, ByVal lIndexEnd As Long) As Boolean
    'Xu ly...
End Function

Thì như vầy:

Function DeleteElementArray2D(ByRef arrSource As Variant, ByVal lIndexBegin As Long, ByVal lIndexEnd As Long) As Boolean
[COLOR=#ff0000]    Dim arrDest() As Variant[/COLOR]
    'Xu ly...
    
[COLOR=#0000ff]    'Mat thoi gian cho nay:[/COLOR]
[B][COLOR=#ff0000]    arrSource = arrDest[/COLOR][/B]
End Function

Cái quan trọng là khi mảng cuối chính là mảng đầu được thay đổi thì lại mất thời gian rất nhiều; bởi em muốn mảng đó là mảng Public, dùng đi dùng lại rất nhiều, nếu mỗi lần xóa hàng thì ra một mảng mới thì đó là điều không thể. Anh Tuân có cách nào copy ngoài việc arrSource = arrDest hay không?

 

[Nguyễn Duy Tuân]

Function DeleteElementArray2D(ByRef arrSource As Variant, ByVal lIndexBegin As Long, ByVal lIndexEnd As Long) As Boolean
[COLOR=#ff0000]    Dim arrDest() As Variant[/COLOR]
    'Xu ly...
    
[COLOR=#0000ff]    'Mat thoi gian cho nay:[/COLOR]
[B][COLOR=#ff0000]    arrSource = arrDest[/COLOR][/B]
End Function

Cái quan trọng là khi mảng cuối chính là mảng đầu được thay đổi thì lại mất thời gian rất nhiều; bởi em muốn mảng đó là mảng Public, dùng đi dùng lại rất nhiều, nếu mỗi lần xóa hàng thì ra một mảng mới thì đó là điều không thể. Anh Tuân có cách nào copy ngoài việc arrSource = arrDest hay không?

Trong VBA/VB6 nếu gán arrSource = arrDest là nó copy dữ liệu từ biến bên phải sang cho biến bên trái. Với mảng nếu số phần tử càng nhiều thì càng chậm. Vậy nên nếu ta chỉ quan tâm tới arrSource còn arrDest "bỏ đi" thì dùng phương pháp vẫn dùng là copy địa chỉ vùng nhớ của arrDest sang cho arrSource thì sẽ nhanh như chớp.

Thay đoạn
arrSource = arrDest
thành

[GPECODE=vb] lLowSourceD1 = LBound(arrDest, 1)
lHighSourceD1 = UBound(arrDest, 1)

ReDim arrSource(lLowSourceD1 To UBound(arrDest, 1), _
lLowSourceD2 To UBound(arrDest, 2)) As Variant

For I = LBound(arrDest, 2) To UBound(arrDest, 2) 'Copy columns
CopyMemory ByVal VarPtr(arrSource(lLowSourceD1, I)), _
ByVal VarPtr(arrDest(lLowSourceD1, I)), _
SZ_VARIANT * (lHighSourceD1 - lLowSourceD1 + 1)
Next I
[/GPECODE]