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,768
Được thích
10,281
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

X
Tự động giãn dòng và ẩn các dòng bị bỏ trống
Trả lời
2
Đọc
75
xuanthucle
X
A
  • Đã giải quyết
Xin giúp đỡ code VBA chép cột dữ liệu có điều kiện từ file này sang file khác
2 3
Trả lời
59
Đọc
3K
Hoàng Nhật Phương
Hoàng Nhật Phương
S
Tính trung bình của tháng đầu tiên.
Trả lời
3
Đọc
212
Phuocam
Phuocam
T
  • Question Question
Xin code VBA trả về tên tài khoản theo điều kiện
    • Chấp nhận
Trả lời
10
Đọc
210
DeTong
D
H
Nhờ các cao nhân chỉ giáo code file Form nhập liệu Google Sheet !!!
    • Thích
Trả lời
4
Đọc
85
befaint
befaint
hoamattroicoi
TỔNG HỢP TỜ KHAI THUẾ THEO THÔNG TƯ 80/2021 TỪ *.XML SANG EXCEL
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
7
Đọc
3K
Nguyễn Văn Thái 92
N
N
  • Question Question
Cần giúp rút gọn code vba
Trả lời
7
Đọc
176
DeTong
D
M
  • Question Question
Code VBA tìm mã kiện gỗ còn tồn kho
Trả lời
0
Đọc
40
moihocvba
M
dungdodac
Lỗi khi COPY , viền xung quanh ô được chọn đứng yên, không chạy
    • Cười
Trả lời
4
Đọc
201
VetMini
V
B
Xin hàm đếm số lượng khách hàng theo 1 điều kiện và bỏ dữ liệu trùng.
Trả lời
10
Đọc
368
Phan Thế Hiệp
Phan Thế Hiệp
Manhhung90
  • Question Question
Xin giúp chuyển dữ liệu từ cột dọc sang hàng ngang theo điều kiện
    • Cười
Trả lời
1
Đọc
50
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ExplorerXL - Quản lý thư mục với Excel: tìm, đổi tên, sao chép, di chuyển và xóa
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
79
Đọc
16K
viethung78
V
H
Giao diện mới ở "chế độ tối" mờ quá
    • Yêu thích
    • Thích
Trả lời
4
Đọc
140
OverAC
OverAC
J
quản lý dữ liệu theo cách quản lý bãi container
    • Thích
Trả lời
2
Đọc
7K
vunhai
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
13 14 15
Trả lời
298
Đọc
20K
ongke0711
ongke0711
M
Sắp xếp dữ liệu: Lọc tên theo ABC (alphabet) có lỗi tên Đam đứng trước Diệp
Trả lời
13
Đọc
5K
maidinhdung5
maidinhdung5
Nguyễn Duy Tuân
Hàm BS_FORMATTEXT Tạo công thức định dạng văn bản trong Excel với Add-in A-Tools v10
Trả lời
0
Đọc
42
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Hàm BS_TEXT trộn văn bản trong Excel với Add-in A-Tools v10
Trả lời
0
Đọc
36
Nguyễn Duy Tuân
Nguyễn Duy Tuân
aduc
Nhật ký thi công bằng excel
    • Thích
2
Trả lời
36
Đọc
53K
PhanTuHuong
PhanTuHuong
likosin
xin cách lọc này với ạ.
Trả lời
4
Đọc
141
ptm0412
ptm0412
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới
Back
Top Bottom