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

Liên hệ QC
Nguyễn Duy Tuân

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,737
Được thích
10,243
Giới tính
Nam
Nghề nghiệp
Giáo viên, CEO tại Bluesofts
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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
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
ThangCuAnh đã viết:
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ô.
Nhấp chuột vào đây để mở rộng...
Í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
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
Mới xem lại code của mạnh 1 năm trước thì ra có sử dụng rồi .... ít ngày nữa xử lý xong công việc ... quậy bank xác các kiểu ra xem nó ra cái gì .... mạnh cảm ơn

1635907799671.png

Bạn nào iu thích delphi có thể tham khảo thêm link sau

VariantArrayLockUnlock (Delphi) - RAD Studio Code Examples

docwiki.embarcadero.com docwiki.embarcadero.com
 
Lần chỉnh sửa cuối:
Upvote 0
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
ThangCuAnh đã viết:
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ễ :(
Nhấp chuột vào đây để mở rộng...

Anh so sánh với code VBA nào?
 
Upvote 0
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 Bảo Ninh đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
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
ThangCuAnh đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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
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
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
ThangCuAnh đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
ThangCuAnh đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
Nguyễn Bảo Ninh đã viết:
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 ạ
Nhấp chuột vào đây để mở rộ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
ThangCuAnh đã viết:
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 !!!???
Nhấp chuột vào đây để mở rộng...
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
Data, file đâu trời ?
 
Upvote 0
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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

keandanh141
Hướng dẫn hàm số tạo số ngẫu nhiên sao cho tổng bằng đúng 1 số
Trả lời
9
Đọc
145
CHAOQUAY
C
dunghtgiga
Tính bốn tuần cho một tháng
Trả lời
5
Đọc
98
Nhim5523
N
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
9 10 11
Trả lời
216
Đọc
12K
ongke0711
ongke0711
HeSanbi
  • Đã giải quyết
HÀM FITROW - Co giãn dòng tự động tối ưu nhất cho Excel v2.42 (*14/10/2024)
    • Thích
    • Yêu thích
2 3
Trả lời
42
Đọc
21K
HeSanbi
HeSanbi
tamvie
Hướng dẫn dùng công cụ Goal Seek kết hợp với Macro để tính ra mức lương Gross
    • Thích
Trả lời
5
Đọc
2K
tranductruong90
T
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
10
Đọc
862
PhanTuHuong
PhanTuHuong
noisy
Nhờ hỗ trợ chuyển về chế độ xem thường trong excel
Trả lời
0
Đọc
30
noisy
noisy
thiensu
Giúp tôi lấy sheet name trong Excel
Trả lời
12
Đọc
13K
dactanhanglk
D
Tuấn Bụng Bự
DataBase (CSDL) nào cho lập trình VBA trong Excel ?
Trả lời
19
Đọc
553
Tuấn Bụng Bự
Tuấn Bụng Bự
L
Nhờ giúp công thức nhiều điều kiện ngày không liên tục
Trả lời
3
Đọc
103
huuthang_bd
huuthang_bd
T
File Excel bị đơ khi sửa số liệu
Trả lời
16
Đọc
184
vanle33
vanle33
N
Tính tổng giá trị hàng hóa của nhiều mặt hàng ( mỗi mặt hàng có 2 đến 3 giá )
2
Trả lời
34
Đọc
373
tranhungdao12a3
T
Hai Lúa Miền Tây
Nhập liệu, truy vấn dữ liệu qua Internet = VB.Net
    • Thích
2
Trả lời
32
Đọc
10K
nguyendang95
N
dllt2805
MẪU QUẢN LÝ CÔNG VIỆC ĐỘI NHÓM BẰNG EXCEL
Trả lời
10
Đọc
1K
dungluyen2119
dungluyen2119
B
Suy nghĩ của tui
    • Thích
2 3
Trả lời
58
Đọc
6K
SA_DQ
SA_DQ
thuyyeu99
  • Question
Kiểm tra file có tồn tại không
2
Trả lời
22
Đọc
13K
khonggianviet
K
Vũ trần bảo ngọc
Lỗi kết hợp hàm if và left
Trả lời
19
Đọc
267
HieuCD
H
T
Lỗi import dữ liệu
Trả lời
2
Đọc
164
hvnhpro
H
Quyen182
  • Question
Xin giúp code VBA để chèn ảnh có sẵn trong Excel vào phần comment
Trả lời
4
Đọc
274
Hoàng Tuấn 868
H
B
  • Question
Xin hướng dẫn tách 1 vùng dữ liệu sang thành nhiều sheet
Trả lời
4
Đọc
236
Bony_handsome
B
Xem thêm…

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

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

Back
Top Bottom