AI muốn lập trình DLL cho Excel và các loại bằng Delphi thì xem video này nhé!

Blue Softs epl Liên hệ QC

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,500
Được thích
9,936
Giới tính
Nam
Nghề nghiệp
Giáo viên, CEO tại Bluesofts
Lần chỉnh sửa cuối:

ThangCuAnh

Mới rờ Ét xeo
Tham gia
1/12/17
Bài viết
875
Được thích
775
Giới tính
Nam
Nghề nghiệp
Coder nghỉ hưu, RCE dạo
Mình decompile code hàm TransArr ra và phát hiện chổ chậm nó rồi, cũng như hàm GetSumRange. Cách fix cũng tương tự cách fix cho hàm GetSumRange ở trên.
Nội cái dòng:
Result[i, j] := ssArr[j, i];
Delphi sinh ra code ASM như vầy đây:
1635845780357.png
Chờ mình code cho xem vd
 
Upvote 0

ThangCuAnh

Mới rờ Ét xeo
Tham gia
1/12/17
Bài viết
875
Được thích
775
Giới tính
Nam
Nghề nghiệp
Coder nghỉ hưu, RCE dạo
C++:
{$DEFINE TEST}

{$IFDEF TEST}
program Test;
{$APPTYPE CONSOLE}
{$ELSE}
library Test;
{$ENDIF}

uses
  System.Variants;

function FastSumRange(const arr: Variant): Integer; stdcall;
var
  I, J: Integer;
  LB1, LB2, UB1, UB2: Integer;
  PElem: PVariant;
begin
  Result := 0;
  LB1 := VarArrayLowBound(arr, 1);
  UB1 := VarArrayHighBound(arr, 1);
  LB2 := VarArrayLowBound(arr, 2);
  UB2 := VarArrayHighBound(arr, 2);
  PElem := VarArrayLock(arr);
  try
    for I := LB1 to UB1 do
      for J := LB2 to UB2 do
      begin
        Result := Result + PVarData(PElem).VInteger;
        Inc(PElem);
      end;
  finally
    VarArrayUnlock(arr);
  end;
end;

exports
  FastSumRange;

{$IFDEF TEST}
var
  vArr: Variant;
  I, J: Integer;
  Sum: Integer;
begin
  vArr := VarArrayCreate([0, 3, 0, 5], varVariant);
  for I := 0 to 3 do
    for J := 0 to 5 do
      vArr[I, J] := I + J;
  Sum := FastSumRange(vArr);
  WriteLn(Sum);
  ReadLn;
{$ENDIF}
end.
Đây là đoạn code mình code minh họa cho các bạn cách dùng Pointer, truy xuất trực tiếp tới từng memory của từng phần tử trong 1 array của Variant/xxx bất kỳ.
Dựa vào đây các bạn có thể độ chế lại theo yêu cầu của riêng mình.
Bao fast và vé ri vé ri nhanh nhé các bạn, vì tránh được _VarArrayGet và _VarArrayPut.
Bài đã được tự động gộp:

Mã ASM mà Delphi compiler sinh ra, sau khi qua decompiler ngược lại.
Các bạn thấy trong vòng lặp không còn _VarArrayGet và _VarArrayPut.
Chỉ là thao tác công và dịch con trỏ PLem lên sizeof(Variant)
1635905309402.png
Các bạn chú ý dòng này, điểm quan trong:
Result := Result + PVarData(PElem).VInteger;
Nếu các bạn viết:
Result := Result + PElem^
Thì Delphi compiler sẽ sinh mã gọi các hàm internal để convert 1 giá trị Variant to kiểu của biến Result. Ở đây là Integer thì sẽ là _VarAsInteger, và linh tinh nữa, sẽ kéo tốc độ xuống.
Vì Variant là kiểu union TVarData nên mình ép kiểu pointer của PElem từ con trỏ PVariant với PVarData, lấy trực tiếp field của nó luôn.
Nên tránh luôn được các hàm internal mà Delphi compiler chèn vô.
 
Lần chỉnh sửa cuối:
Upvote 0

Kiều Mạnh

IIIIIIIIIIIIIIIII
Tham gia
9/6/12
Bài viết
4,583
Được thích
3,225
Giới tính
Nam
C++:
{$DEFINE TEST}

{$IFDEF TEST}
program Test;
{$APPTYPE CONSOLE}
{$ELSE}
library Test;
{$ENDIF}

uses
  System.Variants;

function FastSumRange(const arr: Variant): Integer; stdcall;
var
  I, J: Integer;
  LB1, LB2, UB1, UB2: Integer;
  PElem: PVariant;
begin
  Result := 0;
  LB1 := VarArrayLowBound(arr, 1);
  UB1 := VarArrayHighBound(arr, 1);
  LB2 := VarArrayLowBound(arr, 2);
  UB2 := VarArrayHighBound(arr, 2);
  PElem := VarArrayLock(arr);
  try
    for I := LB1 to UB1 do
      for J := LB2 to UB2 do
      begin
        Result := Result + PVarData(PElem).VInteger;
        Inc(PElem);
      end;
  finally
    VarArrayUnlock(arr);
  end;
end;

exports
  FastSumRange;

{$IFDEF TEST}
var
  vArr: Variant;
  I, J: Integer;
  Sum: Integer;
begin
  vArr := VarArrayCreate([0, 3, 0, 5], varVariant);
  for I := 0 to 3 do
    for J := 0 to 5 do
      vArr[I, J] := I + J;
  Sum := FastSumRange(vArr);
  WriteLn(Sum);
  ReadLn;
{$ENDIF}
end.
Đây là đoạn code mình code minh họa cho các bạn cách dùng Pointer, truy xuất trực tiếp tới từng memory của từng phần tử trong 1 array của Variant/xxx bất kỳ.
Dựa vào đây các bạn có thể độ chế lại theo yêu cầu của riêng mình.
Bao fast và vé ri vé ri nhanh nhé các bạn, vì tránh được _VarArrayGet và _VarArrayPut.
Bài đã được tự động gộp:

Mã ASM mà Delphi compiler sinh ra, sau khi qua decompiler ngược lại.
Các bạn thấy trong vòng lặp không còn _VarArrayGet và _VarArrayPut.
Chỉ là thao tác công và dịch con trỏ PLem lên sizeof(Variant)
View attachment 268661
Các bạn chú ý dòng này, điểm quan trong:
Result := Result + PVarData(PElem).VInteger;
Nếu các bạn viết:
Result := Result + PElem^
Thì Delphi compiler sẽ sinh mã gọi các hàm internal để convert 1 giá trị Variant to kiểu của biến Result. Ở đây là Integer thì sẽ là _VarAsInteger, và linh tinh nữa, sẽ kéo tốc độ xuống.
Vì Variant là kiểu union TVarData nên mình ép kiểu pointer của PElem từ con trỏ PVariant với PVarData, lấy trực tiếp field của nó luôn.
Nên tránh luôn được các hàm internal mà Delphi compiler chèn vô.
ÍT ngày nữa rảnh Mạnh áp dụng vào hàm chuyển mảng kia xem tình hình sao mới biết được
Thử 1 cái Array có 10 triệu dòng x 50 cột xem sao có nhanh hơn hay ko ???

Cảm ơn lắm lắm
 
Upvote 0

ThangCuAnh

Mới rờ Ét xeo
Tham gia
1/12/17
Bài viết
875
Được thích
775
Giới tính
Nam
Nghề nghiệp
Coder nghỉ hưu, RCE dạo
KKK, tui không có nói lý thuyết suông nhe bạn Mạnh. Nhớ đó. Tui hiểu chắc, sâu cái gì tui mới nói.
Để xem bạn áp dụng vào hàm TransArr của bạn có đúng không ?
Tui đang rảnh, có thể code, sửa ngay hàm đó cho bạn. Bạn code còn bug nhiều lắm.
Nhưng không, để cho bạn tự làm, rồi bạn sẽ hiểu ra nhiều, sâu hơn.
Tốt hơn cho bạn.
 
Upvote 0

Kiều Mạnh

IIIIIIIIIIIIIIIII
Tham gia
9/6/12
Bài viết
4,583
Được thích
3,225
Giới tính
Nam
Lần chỉnh sửa cuối:
Upvote 0

ThangCuAnh

Mới rờ Ét xeo
Tham gia
1/12/17
Bài viết
875
Được thích
775
Giới tính
Nam
Nghề nghiệp
Coder nghỉ hưu, RCE dạo
Mình đo thử trên dữ liệu mình thử tạo là 1 triệu dòng, 5 cột, thì đáng buồn là không nhanh hơn được bao nhiêu.
Delphi 10.4.2 64bit, Excel 2016 64bit.
Chứng tỏ code VBA được compile và execute rất tốt.
Hàm FastSumRange mình sửa lại 1 chút, từ 2 vòng for thành 1 vòng, cải tiến thêm được 1 chút tốc độ (giảm bớt số lệnh, lần CPU nhảy)
Mã:
function FastSumRange(const arr: Variant): Double; stdcall;
var
  I, Count: Integer;
  LB1, LB2, UB1, UB2: Integer;
  PElem: PVariant;
begin
  Result := 0;
  LB1 := VarArrayLowBound(arr, 1);
  UB1 := VarArrayHighBound(arr, 1);
  LB2 := VarArrayLowBound(arr, 2);
  UB2 := VarArrayhighBound(arr, 2);
  Count := (UB1 - LB1 + 1) * (UB2 - LB2 + 1);
  PElem := VarArrayLock(arr);
  try
    for I := 0 to Count - 1 do
    begin
      Result := Result + PVarData(PElem).VDouble;
      Inc(PElem);
    end;
  finally
    VarArrayUnlock(arr);
  end;
end;
Đúng là đua với MS coder không dễ :(
 
Lần chỉnh sửa cuối:
Upvote 0

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,500
Được thích
9,936
Giới tính
Nam
Nghề nghiệp
Giáo viên, CEO tại Bluesofts
Mình đo thử trên dữ liệu mình thử tạo là 1 triệu dòng, 5 cột, thì đáng buồn là không nhanh hơn được bao nhiêu.
Delphi 10.4.2 64bit, Excel 2016 64bit.
Chứng tỏ code VBA được compile và execute rất tốt.
Hàm FastSumRange mình sửa lại 1 chút, từ 2 vòng for thành 1 vòng, cải tiến thêm được 1 chút tốc độ (giảm bớt số lần nhảy)
Mã:
function FastSumRange(const arr: Variant): Double; stdcall;
var
  I, Count: Integer;
  LB1, LB2, UB1, UB2: Integer;
  PElem: PVariant;
begin
  Result := 0;
  LB1 := VarArrayLowBound(arr, 1);
  UB1 := VarArrayHighBound(arr, 1);
  LB2 := VarArrayLowBound(arr, 2);
  UB2 := VarArrayhighBound(arr, 2);
  Count := (UB1 - LB1 + 1) * (UB2 - LB2 + 1);
  PElem := VarArrayLock(arr);
  try
    for I := 0 to Count - 1 do
    begin
      Result := Result + PVarData(PElem).VDouble;
      Inc(PElem);
    end;
  finally
    VarArrayUnlock(arr);
  end;
end;
Đúng là đua với MS coder không dễ :(

Anh so sánh với code VBA nào?
 
Upvote 0

Nguyễn Bảo Ninh

Thành viên mới
Tham gia
16/8/17
Bài viết
9
Được thích
2
Giới tính
Nam
Em có test thử hàm anh @ThangCuAnh chia sẻ thì em thử viết dll và COM đều lỗi khi sử dụng VarArrayLowBound(arr, 1);
TH: em gán mảng từ OleVariant và mảng thuần của delphi -> chạy code được nó bị ra giá trị 0, còn bỏ qua các bước sử dụng địa chỉ bộ nhớ thì lại chậm hơn vba.
1635934821940.png

Code delphi
Mã:
function FastSumRange(arr: Variant): Integer; stdcall;
var
  I, Count: Integer;
  LB1, LB2, UB1, UB2: Integer;
  PElem: PVariant;
begin
  Result := 0;
  LB1 := VarArrayLowBound(arr, 1);
  UB1 := VarArrayHighBound(arr, 1);
  LB2 := VarArrayLowBound(arr, 2);
  UB2 := VarArrayhighBound(arr, 2);
  Count := (UB1 - LB1 + 1) * (UB2 - LB2 + 1);
  PElem := VarArrayLock(arr);
  try
    for I := 0 to Count - 1 do
    begin
      Result := Result + PVarData(PElem).VInteger;
      Inc(PElem);
    end;
  finally
    VarArrayUnlock(arr);
  end;
end;

exports
  FastSumRange;

[/ICODE]
VBA
Mã:
#If VBA7 Then
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Private Declare PtrSafe Function FastSumRange Lib "BnAddin.dll" (ByVal Rng As Variant) As Long
#Else
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function FastSumRange Lib "BnAddin.dll" (ByVal Rng As Variant) As Long
#End If

Sub testFastSumRange2()
    Dim t As Double
    t = GetTickCount
    'Dim Com As New BnAddIn.CoBnJson
    Range("C1").Value2 = FastSumRange(Range("A1:A1000000"))
    Range("D1").Value2 = GetTickCount - t
End Sub
 
Upvote 0

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,500
Được thích
9,936
Giới tính
Nam
Nghề nghiệp
Giáo viên, CEO tại Bluesofts
Em có test thử hàm anh @ThangCuAnh chia sẻ thì em thử viết dll và COM đều lỗi khi sử dụng VarArrayLowBound(arr, 1);
TH: em gán mảng từ OleVariant và mảng thuần của delphi -> chạy code được nó bị ra giá trị 0, còn bỏ qua các bước sử dụng địa chỉ bộ nhớ thì lại chậm hơn vba.
View attachment 268704

Code delphi
Mã:
function FastSumRange(arr: Variant): Integer; stdcall;
var
  I, Count: Integer;
  LB1, LB2, UB1, UB2: Integer;
  PElem: PVariant;
begin
  Result := 0;
  LB1 := VarArrayLowBound(arr, 1);
  UB1 := VarArrayHighBound(arr, 1);
  LB2 := VarArrayLowBound(arr, 2);
  UB2 := VarArrayhighBound(arr, 2);
  Count := (UB1 - LB1 + 1) * (UB2 - LB2 + 1);
  PElem := VarArrayLock(arr);
  try
    for I := 0 to Count - 1 do
    begin
      Result := Result + PVarData(PElem).VInteger;
      Inc(PElem);
    end;
  finally
    VarArrayUnlock(arr);
  end;
end;

exports
  FastSumRange;

[/ICODE]
VBA
Mã:
#If VBA7 Then
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Private Declare PtrSafe Function FastSumRange Lib "BnAddin.dll" (ByVal Rng As Variant) As Long
#Else
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function FastSumRange Lib "BnAddin.dll" (ByVal Rng As Variant) As Long
#End If

Sub testFastSumRange2()
    Dim t As Double
    t = GetTickCount
    'Dim Com As New BnAddIn.CoBnJson
    Range("C1").Value2 = FastSumRange(Range("A1:A1000000"))
    Range("D1").Value2 = GetTickCount - t
End Sub

Lỗi sơ đẳng quá. Em đang truyền vào hàm Fast trong VBA là object, trong khi nó đang cần phải kaf array/variant.
 
Upvote 0

ThangCuAnh

Mới rờ Ét xeo
Tham gia
1/12/17
Bài viết
875
Được thích
775
Giới tính
Nam
Nghề nghiệp
Coder nghỉ hưu, RCE dạo
Code này nè Tuân
Mã:
Option Explicit

Declare PtrSafe Function FastSumRange Lib "Test.dll" (ByRef arr As Variant) As Double
Declare PtrSafe Function LoadLibraryA Lib "kernel32.dll" (ByVal DllName As String) As LongPtr

Sub VBACode()
    Dim lr As Long, arr As Variant, tong As Double, i As Long, j As Long
    Dim sStart As Single, sEnd As Single
    sStart = Timer
    With Sheet1
        lr = .Range("A1000000").End(3).Row
        arr = .Range("A1:K" & lr).Value
    End With
    For i = LBound(arr) To UBound(arr)
        For j = LBound(arr, 2) To UBound(arr, 2)
            tong = tong + arr(i, j)
        Next j
    Next i
    sEnd = Timer
    MsgBox tong, , sEnd - sStart
End Sub

Sub DelphiCode()
    Dim sStart As Single, sEnd As Single, lr As Long, arr As Variant, tong As Double
    Dim hDll As LongPtr
    hDll = LoadLibraryA("test.dll")
    sStart = Timer
    With Sheet1
        lr = .Range("A1000000").End(3).Row
        arr = .Range("A1:K" & lr).Value
    End With
    tong = FastSumRange(arr)
    sEnd = Timer
    MsgBox tong, , sEnd - sStart
End Sub
Bạn Bảo Ninh thiếu keyword const trong hàm FastSumRange nhé. Không tự ý bỏ const đi được đâu.
 
Upvote 0

Kiều Mạnh

IIIIIIIIIIIIIIIII
Tham gia
9/6/12
Bài viết
4,583
Được thích
3,225
Giới tính
Nam
Code này nè Tuân
Mã:
Option Explicit

Declare PtrSafe Function FastSumRange Lib "Test.dll" (ByRef arr As Variant) As Double
Declare PtrSafe Function LoadLibraryA Lib "kernel32.dll" (ByVal DllName As String) As LongPtr

Sub VBACode()
    Dim lr As Long, arr As Variant, tong As Double, i As Long, j As Long
    Dim sStart As Single, sEnd As Single
    sStart = Timer
    With Sheet1
        lr = .Range("A1000000").End(3).Row
        arr = .Range("A1:K" & lr).Value
    End With
    For i = LBound(arr) To UBound(arr)
        For j = LBound(arr, 2) To UBound(arr, 2)
            tong = tong + arr(i, j)
        Next j
    Next i
    sEnd = Timer
    MsgBox tong, , sEnd - sStart
End Sub

Sub DelphiCode()
    Dim sStart As Single, sEnd As Single, lr As Long, arr As Variant, tong As Double
    Dim hDll As LongPtr
    hDll = LoadLibraryA("test.dll")
    sStart = Timer
    With Sheet1
        lr = .Range("A1000000").End(3).Row
        arr = .Range("A1:K" & lr).Value
    End With
    tong = FastSumRange(arr)
    sEnd = Timer
    MsgBox tong, , sEnd - sStart
End Sub
Bạn Bảo Ninh thiếu keyword const trong hàm FastSumRange nhé. Không tự ý bỏ const đi được đâu.
Mạnh thử Call nó từ COM thấy lần đầu chạy có vẻ chậm hơn tí teo .... lần 2 to n là o có nghĩa nhanh hơn lần đầu
đoán là COM mất cái khúc Load 1 tí

1635942472013.png

Mã:
Sub DelphiCode()
    Dim sStart As Single, sEnd As Single
    Dim lr As Long, arr As Variant, tong As Double
 
    Dim aSum As New MyLibrary.VBLib
    sStart = Timer
    With Sheet1
        lr = .Range("A1000000").End(3).Row
        arr = .Range("A1:K" & lr).Value
    End With
    tong = aSum.SumRange(arr)
    sEnd = Timer
    MsgBox tong, , sEnd - sStart
End Sub

Mạnh cảm ơn ... ngày mát trời có thêm 1 Hàm vào mục tiện Ích COM class

1635942938305.png

Thử gõ trên Cells thấy chạy cũng thế
Mã:
Function FastSumRange(ByVal DataArray As Range) As Double
    Dim Arr As Variant
    Dim aSum As New MyLibrary.VBLib
    Arr = DataArray.Value
    FastSumRange = aSum.SumRange(Arr)
End Function
 
Lần chỉnh sửa cuối:
Upvote 0

Nguyễn Bảo Ninh

Thành viên mới
Tham gia
16/8/17
Bài viết
9
Được thích
2
Giới tính
Nam
Ban ngày em hơi bận nên chưa có time test, cảm ơn các anh đã chỉ dẫn, em đã test sửa lại theo hướng dẫn của anh @Nguyễn Duy Tuân và anh @ThangCuAnh :
Phạm vi: 5,242,880 cells
TH1: Code dll theo cách của anh @ThangCuAnh -> 484 ms
TH2: truyền trực tiếp Arr xử lý tính toán Arr trong delphi -> 672 ms
TH3: truyền vào range -> trong delphi gán từ rng mới gán sang mảng 532ms
TH4: VBA lỗi OverFlow
TH5: Code COM theo cách của anh @ThangCuAnh -> 250ms
TH6: Code hàm SUM Excel truyền vào Range (không phải array) -> 31 ms
TH7: Code hàm SUM Excel truyền vào Arr được lấy từ range -> 293 ms
Em thấy hiệu suất cách viết của các anh chỉ thì hàm xử lý mảng đã xử lý ở mức độ rất tốt, nếu hàm SUM của excel không phải là tính theo tọa độ mà tính theo Array thì tốc độ gần như tương đương các anh chỉ rồi!

Em muốn hỏi chút các anh là nếu ta sử dụng PElem := VarArrayLock(Rng); -> returns a pointer to the data, vậy nếu em muốn tìm tọa độ chính xác PElem tương tự như PElem[I,J] thì có cách nào không ạ

1635960375900.png
Mã:
Option Explicit
Public comBnFunction As New BnAddIn.coBNSQLFunction
Public comBnJson As New BnAddIn.CoBnJson

Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Declare Function FastSumRange_TH1 Lib "BnAddin.dll" (ByRef Arr As Variant) As Double
Declare Function FastSumRange_TH2 Lib "BnAddin.dll" (ByRef Arr As Variant) As Double
Declare Function FastSumRange_TH3 Lib "BnAddin.dll" (ByRef Arr As Variant) As Double

Sub DelphiTestSum_Excel()
    Dim t As Double
    t = GetTickCount
    Dim Arr
    Arr = Range("A1:E1048576").Value2
    Range("G6").Value2 = WorksheetFunction.Sum(Arr)
    Range("H6").Value2 = GetTickCount - t
End Sub

Sub DelphiTestSumCOM()
    Dim t As Double
    t = GetTickCount
    Dim Arr As Variant
    Arr = Range("A1:E1048576").Value2
    Range("G5").Value2 = comBnJson.BN_FastSumRange(Arr)
    Range("H5").Value2 = GetTickCount - t
End Sub

Sub DelphiTestSum_TH1()
    Dim t As Double
    t = GetTickCount
    'Dim Com As New BnAddIn.CoBnJson
    Dim Arr As Variant
    Arr = Range("A1:E1048576")
    Range("G1").Value2 = FastSumRange_TH1(Arr)
    Range("H1").Value2 = GetTickCount - t
End Sub

Sub DelphiTestSum_TH2()
    Dim t As Double
    t = GetTickCount
    Dim Arr As Variant
    Arr = Range("A1:E1048576")
   
    Range("G2").Value2 = FastSumRange_TH2(Arr)
    Range("H2").Value2 = GetTickCount - t
End Sub

Sub DelphiTestSum_TH3()
    Dim t As Double
    t = GetTickCount
    Range("G3").Value2 = FastSumRange_TH3(Range("A1:E1048576"))
    Range("H3").Value2 = GetTickCount - t
End Sub

Sub TestFastSumRangeVBA()
    Dim t As Double
    t = GetTickCount
    Dim Arr
    Arr = Range("A1:A1048576").Value2
    Dim i, j As Long
    Dim LB1, LB2, UB1, UB2, KQ As Long
    LB1 = LBound(Arr, 1)
    UB1 = UBound(Arr, 1)
    LB2 = LBound(Arr, 2)
    UB2 = UBound(Arr, 2)
    For i = LB1 To UB1
        For j = LB2 To UB2
            KQ = KQ + Arr(i, j)
        Next j
    Next i
    Range("G4").Value2 = KQ
    Range("H4").Value2 = GetTickCount - t
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0

ThangCuAnh

Mới rờ Ét xeo
Tham gia
1/12/17
Bài viết
875
Được thích
775
Giới tính
Nam
Nghề nghiệp
Coder nghỉ hưu, RCE dạo
Bản thân code FastSumRange đã nhanh hết mức có thể rồi, chỉ còn cách dùng multithread/parallel. Nhưng overhead cho sinh thread cũng rất lớn.
Nên chỉ dùng cho các vùng data thật lớn.
Overhead ở đây là do VBA load dll và DllFunctionCall gọi hàm FastSumRange rất lớn, tốn nhiều time.
Nên ở VBA code của mình, mình đã force nó LoadLibraryA trước rồi mới bắt đầu timer.
Bạn Mạnh nên chú ý điểm này, prototype của hàm TransArr là return 1 variant array.
Tức là VBA code sẽ sinh code để copy cái array dll bạn trả về vào biến của VBA. Sẽ take time rất lớn ở đây, nên đo không chính xác.
Mã:
Dim arr1 as Variant, arr2 as Variant
.....
arr1 = TransArr(arr2)
Sẽ take time rất lớn ở phép gán arr1 =
Bạn nên sữa prototype của TransArr lại
VD: function TransArr(const arrSrc: Variant; var arrDst: Variant): Boolean;
Trans thẳng từ arrSrc vào arrDst luôn
 
Lần chỉnh sửa cuối:
Upvote 0

Nguyễn Bảo Ninh

Thành viên mới
Tham gia
16/8/17
Bài viết
9
Được thích
2
Giới tính
Nam
Bản thân code FastSumRange đã nhanh hết mức có thể rồi, chỉ còn cách dùng multithread/parallel. Nhưng overhead cho sinh thread cũng rất lớn.
Nên chỉ dùng cho các vùng data thật lớn.
Overhead ở đây là do VBA load dll và DllFunctionCall gọi hàm FastSumRange rất lớn, tốn nhiều time.
Nên ở VBA code của mình, mình đã force nó LoadLibraryA trước rồi mới bắt đầu timer.
Bạn Mạnh nên chú ý điểm này, prototype của hàm TransArr là return 1 variant array.
Tức là VBA code sẽ sinh code để copy cái array dll bạn trả về vào biến của VBA. Sẽ take time rất lớn ở đây, nên đo không chính xác.
Mã:
Dim arr1 as Variant, arr2 as Variant
.....
arr1 = TransArr(arr2)
Sẽ take time rất lớn ở phép gán arr1 =
Bạn nên sữa prototype của TransArr lại
VD: function TransArr(const arrSrc: Variant; var arrDst: Variant): Boolean;
Trans thẳng từ arrSrc vào arrDst luôn
Em muốn hỏi chút các anh là nếu ta sử dụng PElem := VarArrayLock(Rng); -> returns a pointer to the data, vậy nếu em muốn tìm tọa độ chính xác PElem tương tự như PElem[I,J] thì có cách nào không ạ
 
Upvote 0

Kiều Mạnh

IIIIIIIIIIIIIIIII
Tham gia
9/6/12
Bài viết
4,583
Được thích
3,225
Giới tính
Nam
Bản thân code FastSumRange đã nhanh hết mức có thể rồi, chỉ còn cách dùng multithread/parallel. Nhưng overhead cho sinh thread cũng rất lớn.
Nên chỉ dùng cho các vùng data thật lớn.
Overhead ở đây là do VBA load dll và DllFunctionCall gọi hàm FastSumRange rất lớn, tốn nhiều time.
Nên ở VBA code của mình, mình đã force nó LoadLibraryA trước rồi mới bắt đầu timer.
Bạn Mạnh nên chú ý điểm này, prototype của hàm TransArr là return 1 variant array.
Tức là VBA code sẽ sinh code để copy cái array dll bạn trả về vào biến của VBA. Sẽ take time rất lớn ở đây, nên đo không chính xác.
Mã:
Dim arr1 as Variant, arr2 as Variant
.....
arr1 = TransArr(arr2)
Sẽ take time rất lớn ở phép gán arr1 =
Bạn nên sữa prototype của TransArr lại
VD: function TransArr(const arrSrc: Variant; var arrDst: Variant): Boolean;
Trans thẳng từ arrSrc vào arrDst luôn
Rảnh code dùm cho mạnh cái hàm kia TransArr ... loay hoay nguyên tối qua tới sáng nay chưa ra
Code đó mức độ rất khó rồi ... vượt ngoài tầm hiểu + xử lý của Mạnh
Xin cảm ơn
 
Upvote 0

ThangCuAnh

Mới rờ Ét xeo
Tham gia
1/12/17
Bài viết
875
Được thích
775
Giới tính
Nam
Nghề nghiệp
Coder nghỉ hưu, RCE dạo
Em muốn hỏi chút các anh là nếu ta sử dụng PElem := VarArrayLock(Rng); -> returns a pointer to the data, vậy nếu em muốn tìm tọa độ chính xác PElem tương tự như PElem[I,J] thì có cách nào không ạ
Seek con trỏ đó em. Mãng 2 chiều thôi. Hàng và cột.
Vd: mãng arr[A..B, C..D] of Variant;
PElem: Pointer;
PElem := @arr[A, C]; // tới đầu vùng nhớ của arr, phần tử đầu tiên[A, C]
Thì @arr[I, J] = @arr[A, C] + ((D - C + 1) * I + J) * sizeof(Variant)
Mạnh post file Excel và code VBA lên để mình code hàm TransArr thử xem tốc độ Delphi so với VBA lần này ra sao !!!???
 
Lần chỉnh sửa cuối:
Upvote 0

Kiều Mạnh

IIIIIIIIIIIIIIIII
Tham gia
9/6/12
Bài viết
4,583
Được thích
3,225
Giới tính
Nam
Seek con trỏ đó em. Mãng 2 chiều thôi. Hàng và cột.
Vd: mãng arr[A..B, C..D] of Variant;
PElem: Pointer;
PElem := @arr[A, C]; // tới đầu vùng nhớ của arr, phần tử đầu tiên[A, C]
Thì @arr[I, J] = @arr[A, C] + ((D - C + 1) * I + J) * sizeof(Variant)
Mạnh post file Excel và code VBA lên để mình code hàm TransArr thử xem tốc độ Delphi so với VBA lần này ra sao !!!???
Cách sau mạnh đang dùng là cảm thấy nhanh nhất
Mã:
Private Sub Transpose_Data()
    Dim tmpArray() As Variant
    Dim tmpArray2() As Variant
    Dim Cnn As Object, Rs As Object
    Dim strCon As String
    Dim ExcelPath As String
    Dim srtQry As String
    Rem ========== Khai bao mo ket noi
    Set Cnn = CreateObject("ADODB.Connection")
    Set Rs = CreateObject("ADODB.Recordset")
    ExcelPath = ThisWorkbook.Path & "\Data.xlsb"
    strCon = ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ExcelPath _
            & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;"";")
    Rem ========== Tuy chon Lay du lieu SQL
    Rem srtQry = "Select *" & "From [" & Data_Nhap$ & "]"
    srtQry = "SELECT * FROM [Data_Nhap$]"
    Cnn.Open strCon
    Set Rs = Cnn.Execute(srtQry)
    tmpArray = Rs.GetRows
    Cnn.Close
    Rem ========== Thuc hien chuyen mang 2dArray len Sheet
    Call Transpose_Array(tmpArray, tmpArray2)   ''Chuyen Mang tmpArray Sang tmpArray2
    With Sheets("ADO").Range("A2")
        .Resize(UBound(tmpArray2, 1), UBound(tmpArray2, 2)).ClearContents
        .Resize(UBound(tmpArray2, 1), UBound(tmpArray2, 2)).Value = tmpArray2
    End With
End Sub
Private Sub Transpose_Array(ByRef InputArr() As Variant, ByRef ReturnArray() As Variant)
    Rem Khai bao Dim tmpArray(), tmpArray2() As Variant     ''Tang Toc 50%
    Rem Su Dung Call Transpose_Array (tmpArray, tmpArray2)  ''Chuyen Mang tmpArray Sang tmpArray2
    Dim RowNdx As Long, ColNdx As Long
    Dim LB1 As Long, LB2 As Long
    Dim UB1 As Long, UB2 As Long
    LB1 = LBound(InputArr, 1)
    LB2 = LBound(InputArr, 2)
    UB1 = UBound(InputArr, 1)
    UB2 = UBound(InputArr, 2)
    ReDim ReturnArray(LB2 To UB2, LB1 To UB1)

    For RowNdx = LB2 To UB2
    For ColNdx = LB1 To UB1
        ReturnArray(RowNdx, ColNdx) = InputArr(ColNdx, RowNdx)
    Next ColNdx, RowNdx ''Viet gon lai Bo Next
    Erase InputArr
End Sub
 
Upvote 0

ThangCuAnh

Mới rờ Ét xeo
Tham gia
1/12/17
Bài viết
875
Được thích
775
Giới tính
Nam
Nghề nghiệp
Coder nghỉ hưu, RCE dạo
Data, file đâu trời ?
 
Upvote 0

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,500
Được thích
9,936
Giới tính
Nam
Nghề nghiệp
Giáo viên, CEO tại Bluesofts
Tôi code DLL trong Delphi theo hướng giải quyết khác với anh "ThangCuAnh" và kết quả DLL tôi viết trong Delphi nhanh hơn VBA. Các bạn thử nghiệm trên máy tính của các bạn rồi cho kết quả nhé. Sự so sánh có thể khác nhau giữa các Office 32 hay 64-bit.

"tuanfastcode.dll" là thư viện lập trình bằng Delphi, xuất các hàm APIs gồm
1. CopyArray: Copy hai mảng 2D với nhau
2. TransArray: Đảo chiều mảng 2D
3. FastSumArray: Tổng trong mảng 2D

Để chạy các hàm này cần copy thư viện như sau:
+ Nếu Windows 64 bit
Copy x86\tuanfastcode.dll vào C:\Windows\SysWow64\
Copy x64\tuanfastcode.dll vào C:\Windows\System32\

+ Nếu Windows 32 bit
Copy x86\tuanfastcode.dll vào C:\Windows\System32\

So sánh hàm viết trong DLL này với cách viết tương tự trong VBA.
Chạy mở file "TestTuanFastCode.xlsm", vào VBA chạy code để so sánh.

Tôi đã test với Windows 64-bit, Office365 32-bit
Tốc độ các hàm tôi viết trong Delphi đều nhanh hơn VBA, trong đó hàm FastSumArray nhanh gấp 4 lần. Các bạn có thể test để xem kết quả ra sao.


FastCode.png

Download
 
Upvote 0
Web KT
Top Bottom