Vấn đề về hiệu năng khi thực hiện ghép chuỗi trong VBA với tần suất lớn (1 người xem)

Người dùng đang xem chủ đề này

Tôi tuân thủ nội quy khi đăng bài

nguyendang95

Thành viên hoạt động
Tham gia
25/5/22
Bài viết
189
Được thích
168
Kiểu chuỗi trong VBA là kiểu dữ liệu không biến đổi được (immutable string), tức là chuỗi một khi đã được tạo ra thì kích thước của nó sẽ luôn cố định và không thể thay đổi được. Như vậy khi ghép hai chuỗi với nhau, VBA phải thực hiện những công việc sau đây:
VD: Với biểu thức str = "a" & "b".
  1. Xác định số lượng ký tự của hai chuỗi "a" và "b".
  2. Xin hệ điều hành cấp phát vùng nhớ vừa đủ để chứa hai chuỗi trên.
  3. Sao chép hai chuỗi trên vào vùng nhớ mới được cấp phát.
Kiểu chuỗi trong VBA là kiểu BSTR của COM, kiểu dữ liệu này không khác gì kiểu chuỗi wchar_t của C/C++ ngoại trừ ngay trước mảng chuỗi là 4 byte kiểu long đại diện cho số byte cần dùng để biểu diễn chuỗi và con trỏ trỏ vào phần tử đầu tiên của mảng chuỗi (hay trỏ đến ký tự đầu tiên).

1769177441880.png

Khi thực hiện ghép chuỗi với tần suất không quá nhiều và phép ghép chuỗi đơn giản, lập trình viên có thể không nhận ra sự khác biệt về hiệu năng vì VBA thực hiện công việc nói trên rất nhanh. Tuy nhiên khi cần ghép chuỗi với tần suất lớn thì mọi chuyện sẽ khác:
Mã:
Option Explicit

Private Sub ConcatenateString()
    Dim str As String
    Dim startTime As Date, endTime As Date, elapsedTime As Long
    startTime = Now()
    Dim i As Long
    For i = 1 To 1000000
        str = str & "a"
    Next
    endTime = Now()
    elapsedTime = DateDiff("s", startTime, endTime, vbUseSystemDayOfWeek, vbUseSystem)
    Debug.Print "Elapsed time: " & CStr(elapsedTime) & " seconds"
End Sub
Rõ ràng, khi thực hiện 1 triệu lần ghép chuỗi, trong vòng lặp VBA thực hiện liên tục thao tác xin cấp phát vùng nhớ mới, sao chép chuỗi hiện tại vào vùng nhớ mới và nối chuỗi mới vào vùng nhớ mới chứa chuỗi hiện tại thì thời gian thực hiện kéo dài đáng kể và rất lâu (trong trường hợp này theo phép đo chủ quan phải mất 209 giây để chạy xong mã VBA trên).
Nhược điểm này không chỉ tồn tại ở VBA mà ngay cả những ngôn ngữ lập trình hiện đại hơn như Java lẫn ngôn ngữ nền .NET như C#, Visual Basic và F# cũng thế. Cho nên để giải quyết tình trạng này, người ta thiết kế một cơ chế đặc biệt gọi là string builder (trình xây dựng chuỗi), cái này có nhiệm vụ như sau:
  • Chuẩn bị trước vùng nhớ lớn để chứa chuỗi thay vì gặp chuỗi nào thì xin cấp phát vùng nhớ để chứa thêm chuỗi mới đó.
  • Mỗi ghi có chuỗi mới cần ghép thì sao chép chuỗi đó vào vùng nhớ đã chuẩn bị trước, khi vùng nhớ sắp đầy thì mới xin cấp phát thêm từ hệ điều hành, từ đó giảm thiểu đáng kể số lần xin cấp phát thêm vùng nhớ từ hệ điều hành, giúp hoạt động ghép chuỗi diễn ra nhanh chóng.
Để biểu diễn vấn đề trên, trong bài viết này trình bày mã viết bằng Visual C++ về một trình string builder đơn giản. Thật ra C++ hỗ trợ một lớp (class) tên là std::wstringstream nằm trong tập tin tiêu đề (header file) sstream (#include<sstream>) có chức năng tương tự, tuy nhiên mã trong bài viết này không sử dụng nó, chủ yếu nhằm mục đích diễn giải cách hoạt động của string builder mà thôi.
Khởi chạy Visual Studio, tạo một dự án mới kiểu Dynamic-Link Library (DLL) và chèn vào đoạn mã dưới đây:
dllmain.cpp
C++:
// dllmain.cpp : Defines the entry point for the DLL application.
#include "pch.h"

BOOL APIENTRY DllMain( HMODULE hModule,
                       DWORD  ul_reason_for_call,
                       LPVOID lpReserved
                     )
{
    switch (ul_reason_for_call)
    {
    case DLL_PROCESS_ATTACH:
    case DLL_THREAD_ATTACH:
    case DLL_THREAD_DETACH:
    case DLL_PROCESS_DETACH:
        break;
    }
    return TRUE;
}

typedef struct _STRINGBUILDER {
    wchar_t* buffer;
    DWORD dwccharacters;
    DWORD dwCapacity;
}STRINGBUILDER, *LPSTRINGBUILDER;

extern "C" _declspec(dllexport) LPSTRINGBUILDER WINAPI StringBuilderInitialize() {
    LPSTRINGBUILDER sb = (LPSTRINGBUILDER)HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, (SIZE_T)sizeof(STRINGBUILDER));
    if (!sb) {
        SetLastError(STRINGBUILDER_ERROR_OUT_OF_MEMORY);
        return NULL;
    }
    DWORD dwCapacity = ((1024 * 1024) * 1) * sizeof(wchar_t);
    sb->buffer = (wchar_t*)HeapAlloc(GetProcessHeap(), 0, (SIZE_T)dwCapacity);
    if (!sb->buffer) {
        HeapFree(GetProcessHeap(), 0, sb);
        SetLastError(STRINGBUILDER_ERROR_OUT_OF_MEMORY);
        return NULL;
    }
    sb->dwccharacters = 0;
    sb->buffer[sb->dwccharacters] = '\0';
    sb->dwCapacity = dwCapacity;
    return sb;
}

extern "C" _declspec(dllexport) BOOL WINAPI StringBuilderUninitialize(LPSTRINGBUILDER hObject) {
    if (!hObject || !hObject->buffer) {
        SetLastError(STRINGBUILDER_ERROR_INVALID_POINTER);
        return FALSE;
    }
    if (!HeapFree(GetProcessHeap(), 0, hObject->buffer)) {
        SetLastError(GetLastError());
        return FALSE;
    }
    if (!HeapFree(GetProcessHeap(), 0, hObject)) {
        SetLastError(GetLastError());
        return FALSE;
    }
    return TRUE;
}

extern "C" _declspec(dllexport) BOOL WINAPI StringBuilderAppend(LPSTRINGBUILDER hObject, const wchar_t* lpwstrValue) {
    if (!hObject || !lpwstrValue) {
        SetLastError(STRINGBUILDER_ERROR_INVALID_PARAMETER);
        return FALSE;
    }
    size_t len = wcslen(lpwstrValue);
    if (!len) {
        SetLastError(STRINGBUILDER_ERROR_EMPTY_STRING);
        return FALSE;
    }
    if (((hObject->dwccharacters * sizeof(wchar_t)) + (len * sizeof(wchar_t)) >= hObject->dwCapacity)) {
        DWORD dwNewCapacity = (hObject->dwCapacity + (len * sizeof(wchar_t))) * 1.5;
        wchar_t* ptr = (wchar_t*)HeapReAlloc(GetProcessHeap(), 0, hObject->buffer, (SIZE_T)dwNewCapacity);
        if (!ptr) {
            SetLastError(STRINGBUILDER_ERROR_OUT_OF_MEMORY);
            return FALSE;
        }
        hObject->buffer = ptr;
        hObject->dwCapacity += dwNewCapacity;
    }
    memcpy_s(&(hObject->buffer[hObject->dwccharacters]), (hObject->dwCapacity / sizeof(wchar_t)) - hObject->dwccharacters, lpwstrValue, len * sizeof(wchar_t));
    hObject->dwccharacters += (DWORD)len;
    hObject->buffer[hObject->dwccharacters] = '\0';
    return TRUE;
}

extern "C" _declspec(dllexport) VARIANT StringBuilderToString(LPSTRINGBUILDER hObject) {
    VARIANT varResult = {};
    if (!hObject || !hObject->buffer) {
        SetLastError(STRINGBUILDER_ERROR_INVALID_POINTER);
        varResult.vt = VT_EMPTY;
        return varResult;
    }
    BSTR ptr = SysAllocString(hObject->buffer);
    if (!ptr) {
        SetLastError(STRINGBUILDER_ERROR_OUT_OF_MEMORY);
        varResult.vt = VT_EMPTY;
        return varResult;
    }
    varResult.vt = VT_BSTR;
    varResult.bstrVal = ptr;
    return varResult;
}

StringBuilderErrorCodes.h
C++:
#pragma once
#define STRINGBUILDER_ERROR_INVALID_POINTER 20000 | ((DWORD)1 << 29)
#define STRINGBUILDER_ERROR_INVALID_PARAMETER 20001 | ((DWORD)1 << 29)
#define STRINGBUILDER_ERROR_OUT_OF_MEMORY 20002 | ((DWORD)1 << 29)
#define STRINGBUILDER_ERROR_EMPTY_STRING 20003 | ((DWORD)1 << 29)

pch.h

C++:
// pch.h: This is a precompiled header file.
// Files listed below are compiled only once, improving build performance for future builds.
// This also affects IntelliSense performance, including code completion and many code browsing features.
// However, files listed here are ALL re-compiled if any one of them is updated between builds.
// Do not add files here that you will be updating frequently as this negates the performance advantage.

#ifndef PCH_H
#define PCH_H

// add headers that you want to pre-compile here
#include "framework.h"
#include "StringBuilderErrorCodes.h"
#include <Windows.h>
#include <comdef.h>

#endif //PCH_H

Tiến hành biên dịch ra DLL tương ứng với phiên bản của VBA (32 bit hoặc 64 bit). Khi sử dụng DLL trong VBA để ghép chuỗi:
Mã:
Option Explicit

Private Declare PtrSafe Function StringBuilderInitialize Lib "VBAStringBuilder.dll" () As LongPtr
Private Declare PtrSafe Function StringBuilderUninitialize Lib "VBAStringBuilder.dll" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function StringBuilderAppend Lib "VBAStringBuilder.dll" (ByVal hObject As LongPtr, ByVal lpwstrValue As LongPtr) As Long
Private Declare PtrSafe Function StringBuilderToString Lib "VBAStringBuilder.dll" (ByVal hObject As LongPtr) As Variant
Private Declare PtrSafe Function GetLastError Lib "Kernel32" () As Long

Private Sub ConcatenateString()
    Dim sb As LongPtr, errorCode As Long
    sb = StringBuilderInitialize()
    If sb = 0 Then
        errorCode = GetLastError()
        Debug.Print "Error: " & CStr(errorCode)
        Exit Sub
    End If
    Dim i As Long
    Dim startTime As Date, endTime As Date, elapsedTime As Long
    startTime = Now()
    For i = 1 To 1000000
        If StringBuilderAppend(sb, StrPtr("a")) = 0 Then
            errorCode = GetLastError()
            Debug.Print "Error: " & CStr(errorCode)
            Exit Sub
        End If
    Next
    endTime = Now()
    elapsedTime = DateDiff("s", startTime, endTime, vbUseSystemDayOfWeek, vbUseSystem)
    Debug.Print "Elapsed time: " & CStr(elapsedTime) & " seconds"
    Call StringBuilderUninitialize(sb)
End Sub

Thời gian thực hiện 1 triệu lần ghép chuỗi đã giảm đáng kể so với phép ghép chuỗi thông thường của VBA (trong trường hợp này theo phép đo chủ quan, chỉ mất vỏn vẹn 4 giây để chạy xong mã trên).
 
Hiểu được cơ chế copy lại vùng nhớ nhiều lần, hỏi AI cách giảm thời gian copy vùng nhớ ^^
ý tưởng là xử lý từng phần tử , rồi Join các phần tử lại 1 lần thành mảng !

Mã:
Option Explicit

Dim str(1000000)
Dim i, finalString, startTime, endTime

' 1. Gan gia tri vao mang
startTime = Timer() ' do thoi gian mini giay
For i = 1 To 1000000
    str(i) = "a"
Next

    str(999997) = "c"
    str(999998) = "d"
    str(999999) = "e"

' 2. Gop mang thanh chuoi
' Ham Join lay toan bo phan tu trong mang noi thanh chuoi duy nhat
finalString = Join(str, "")

endTime = Timer()

' 3. Hien thi ket qua
MsgBox "Thoi gian xu ly: " & Round(endTime - startTime, 4) & " giay." & vbCrLf & _
       "Do dai chuoi: " & Len(finalString) & " ky tu." & vbCrLf & _
       "10 ky tu ben phai: " & right(finalString, 10)
1769221557288.png
 
Hiểu được cơ chế copy lại vùng nhớ nhiều lần, hỏi AI cách giảm thời gian copy vùng nhớ ^^
ý tưởng là xử lý từng phần tử , rồi Join các phần tử lại 1 lần thành mảng !

Mã:
Option Explicit

Dim str(1000000)
Dim i, finalString, startTime, endTime

' 1. Gan gia tri vao mang
startTime = Timer() ' do thoi gian mini giay
For i = 1 To 1000000
    str(i) = "a"
Next

    str(999997) = "c"
    str(999998) = "d"
    str(999999) = "e"

' 2. Gop mang thanh chuoi
' Ham Join lay toan bo phan tu trong mang noi thanh chuoi duy nhat
finalString = Join(str, "")

endTime = Timer()

' 3. Hien thi ket qua
MsgBox "Thoi gian xu ly: " & Round(endTime - startTime, 4) & " giay." & vbCrLf & _
       "Do dai chuoi: " & Len(finalString) & " ky tu." & vbCrLf & _
       "10 ky tu ben phai: " & right(finalString, 10)
View attachment 310950
Vậy khi không còn là chuỗi đơn lẻ kiểu như "a" hay "b" nữa mà là "abc" hay "defgh" thì bạn sẽ làm như thế nào để gán chúng vào mảng?
 
gán bình thường như cân đường thôi bạn !
giả xử có danh sách họ tên 1 triệu dòng , thì Join cũng dưới 1 giây ah,
tiếc là máy mình giờ không có Excel , giờ mình làm việc chủ yếu trên Phython không thì sẽ test cho bạn xem,
thực ra C++ nó là ngôn ngữ cấp thấp thôi , mấy cái việc sắp xếp vùng nhớ, xử lý data này kia dùng C++ thì thủ công quá, mấy việc này mấy ngôn ngữ cấp cao có thư viện hỗ trợ hết rồi, mình học thuộc là xài thôi !

Mã:
Option Explicit

Dim str(1000000)
Dim i, finalString, startTime, endTime

' 1. Gan gia tri vao mang
startTime = Timer() ' do thoi gian mini giay
For i = 1 To 1000000
    str(i) = "abc"
Next

    str(999997) = "sdfsdf"
    str(999998) = "dqweqwe"
    str(999999) = "cvbvcb"

' 2. Gop mang thanh chuoi
' Ham Join lay toan bo phan tu trong mang noi thanh chuoi duy nhat
finalString = Join(str, "")

endTime = Timer()

' 3. Hien thi ket qua
MsgBox "Thoi gian xu ly: " & Round(endTime - startTime, 4) & " giay." & vbCrLf & _
       "Do dai chuoi: " & Len(finalString) & " ky tu." & vbCrLf & _
       "10 ky tu ben phai: " & right(finalString, 100)

1769222937049.png
 
Lần chỉnh sửa cuối:
Tôi dùng code bài 4 đọc và nối 1 triệu tên nhân viên ở cột B

1769225127382.png

1769225198855.png
 
gán bình thường như cân đường thôi bạn !
giả xử có danh sách họ tên 1 triệu dòng , thì Join cũng dưới 1 giây ah,
tiếc là máy mình giờ không có Excel , giờ mình làm việc chủ yếu trên Phython không thì sẽ test cho bạn xem,
thực ra C++ nó là ngôn ngữ cấp thấp thôi , mấy cái việc sắp xếp vùng nhớ, xử lý data này kia dùng C++ thì thủ công quá, mấy việc này mấy ngôn ngữ cấp cao có thư viện hỗ trợ hết rồi, mình học thuộc là xài thôi !

Mã:
Option Explicit

Dim str(1000000)
Dim i, finalString, startTime, endTime

' 1. Gan gia tri vao mang
startTime = Timer() ' do thoi gian mini giay
For i = 1 To 1000000
    str(i) = "abc"
Next

    str(999997) = "sdfsdf"
    str(999998) = "dqweqwe"
    str(999999) = "cvbvcb"

' 2. Gop mang thanh chuoi
' Ham Join lay toan bo phan tu trong mang noi thanh chuoi duy nhat
finalString = Join(str, "")

endTime = Timer()

' 3. Hien thi ket qua
MsgBox "Thoi gian xu ly: " & Round(endTime - startTime, 4) & " giay." & vbCrLf & _
       "Do dai chuoi: " & Len(finalString) & " ky tu." & vbCrLf & _
       "10 ky tu ben phai: " & right(finalString, 100)

View attachment 310951
Cái này là sai về mặt nguyên tắc rồi bạn ơi, mảng trong VBA thực chất là kiểu SAFEARRAY của COM, bạn gán chuỗi cho mỗi phần tử của mảng thực chất là gán con trỏ trỏ về mảng chuỗi (ở đây là BSTR), mỗi lần như vậy phải xin hệ điều hành cấp phát vùng nhớ mới rồi mới ghi chuỗi vào đó được, chưa kể những chuỗi này nằm rải rác ở trên RAM chứ đâu có nằm chung trong một vùng nhớ liên tục đâu, lúc cần sửa, xóa, chèn chuỗi mới vào vị trí nào đó thì không biết phải làm thế nào vừa đơn giản lại vừa đỡ tốn sức CPU nhất, chưa kể lúc mảng đầy rồi thì giả sử dùng ReDim Preserve cho đơn giản thì đó lại là một câu chuyện khác nữa.
Bạn có thể tìm hiểu code VBA trong bài viết này xem có gì thú vị không:
A lightning-fast StringBuilder
 
Nếu không đọc từng ô trên sheet mà lấy giá trị range vào mảng thì nhanh hơn.
Lưu ý là tôi chỉ thực nghiệm chứ không đánh giá đúng/ sai, vì thực chất tôi chả hiểu sâu việc xin và cấp phát bộ nhớ.

1769225520364.png

1769225555817.png
 
Tôi dùng code bài 4 đọc và nối 1 triệu tên nhân viên ở cột B

View attachment 310952

View attachment 310953
hàm Cells e thấy hình như hút data trên lưới của Excel, thời gian sẽ chậm hơn,
nếu đọc khối data này vào bộ nhớ thì xử lý sẽ nhanh hơn
duLieu = Range("B1:B100000").Value
For i=0 to 999999
str(i+1)= duLieu(i ,0)
Next i


Cái này là sai về mặt nguyên tắc rồi bạn ơi, mảng trong VBA thực chất là kiểu SAFEARRAY của COM, bạn gán chuỗi cho mỗi phần tử của mảng thực chất là gán con trỏ trỏ về mảng chuỗi (ở đây là BSTR), mỗi lần như vậy phải xin hệ điều hành cấp phát vùng nhớ mới rồi mới ghi chuỗi vào đó được, chưa kể những chuỗi này nằm rải rác ở trên RAM chứ đâu có nằm chung trong một vùng nhớ liên tục đâu, lúc cần sửa, xóa, chèn chuỗi mới vào vị trí nào đó thì không biết phải làm thế nào vừa đơn giản lại vừa đỡ tốn sức CPU nhất, chưa kể lúc mảng đầy rồi thì giả sử dùng ReDim Preserve cho đơn giản thì đó lại là một câu chuyện khác nữa.
Bạn có thể tìm hiểu code VBA trong bài viết này xem có gì thú vị không:
A lightning-fast StringBuilder

mình chỉ học thuộc và xài thôi àh, vấn đề nêu ra, nếu giải pháp trên đáp ứng được , thì là được việc của mình , mình cũng hiếm khi so đo nhà sản xuất họ làm gì bên trong ^^
với trường hợp muốn chèn thêm , thì có thể dịch các phần tử qua trái 1 ký tự chẳng hạn,
thực ra với data rải rác , thì CPU cũng phải đi tìm trên Ram dựa trên con trỏ , rồi lắp ráp lại , vì thế mới tốn 4 giây xử lý,
nếu làm cách của VBA thì có nhiều cách , tạo 1 mảng 2 chiều ngang 10 , dài 1000000, nếu chèn thì gán vào các cột kế bên, kết quả cuối cùng mình kéo dãn nó thành mảng 1 chiều, thì cũng xong bài toán !
 
Lần chỉnh sửa cuối:
Nếu không đọc từng ô trên sheet mà lấy giá trị range vào mảng thì nhanh hơn.
Lưu ý là tôi chỉ thực nghiệm chứ không đánh giá đúng/ sai, vì thực chất tôi chả hiểu sâu việc xin và cấp phát bộ nhớ.

View attachment 310954

View attachment 310955
Trường hợp này của bạn là dữ liệu đã có từ trước và đã biết trước kích thước để chuẩn bị kịch bản ghép chuỗi rồi bạn, người ta hay sử dụng string builder là vì không thể nào biết trước được sẽ có bao nhiêu chuỗi cần nối, chuỗi dài hay ngắn để chuẩn bị cho bộ đệm sao cho đủ lớn để chứa hết các chuỗi cần ghép.
 
VBA có cấp phát vùng nhớ động ák

Dim mang()
ReDim mang(100000) ' Cấp phát vùng nhớ' ... xử lý dữ liệu ...

Dim Phan_tu
Phan_tu = 5000000 ' cấp lại 5000000
ReDim mang(1 to Phan_tu)

Erase mang ' Hủy hoàn toàn mảng và giải phóng bộ nhớ RAM

--------------------code dãn vùng nhớ để data cũ không mất ----------
Mã:
Sub ThemPhanTuVaoCuoi()
    Dim mang() As Variant
    Dim soLuong As Long
    
    ' Bắt đầu với mảng nhỏ
    ReDim mang(1 To 3)
    mang(1) = "A"
    mang(2) = "B"
    mang(3) = "C"
    
    ' Muốn thêm 1 phần tử mới → tăng lên 4 phần tử
    soLuong = UBound(mang) + 1           ' 4
    ReDim Preserve mang(1 To soLuong)    ' ← giữ dữ liệu cũ
    
    mang(4) = "D"                        ' gán giá trị mới
    
    ' Kết quả: A, B, C, D (dữ liệu cũ vẫn còn)
    MsgBox "Phần tử cuối: " & mang(UBound(mang))
End Sub
 
Lần chỉnh sửa cuối:
StringBuilder lớp hiệu suất cao dành cho VBA nói riêng và cho toàn bộ VB

JavaScript:
Option Explicit

'Internal BUFFER Struct
Private Type BUFFER_STRUCT
    text_ As String
    endIndex_ As Long
    capacity_ As Long
End Type

'Class members
Private m_buffer As BUFFER_STRUCT

'*******************************************************************************
'Append new text to buffer
'*******************************************************************************
Public Sub Append(ByVal textToAppend As String)
    Dim addedLength As Long: addedLength = Len(textToAppend)
    If addedLength = 0 Then Exit Sub
    Dim newEndIndex As Long: newEndIndex = m_buffer.endIndex_ + addedLength
    '
    'EnsureCapacity already checks for: newEndIndex > m_buffer.capacity_
    'When many appends are done (ex. 1 character at a time for a million times)
    '   then the extra 'If' is faster than exiting the scope of this function
    '   i.e. avoid pushing a new stack frame at the top of the call stack
    If newEndIndex > m_buffer.capacity_ Then EnsureCapacity newEndIndex
    '
    'Replace unused characters with the new text after the last used position
    'The Mid Statement can be used to quickly replace characters
    'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-statement
    Mid$(m_buffer.text_, m_buffer.endIndex_ + 1, addedLength) = textToAppend
    '
    'Store last character position
    m_buffer.endIndex_ = newEndIndex
End Sub
'*******************************************************************************
'Delete a portion of the text
'*******************************************************************************
Public Sub Delete(ByVal startIndex As Long, ByVal length_ As Long)
    'Validate Input
    If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then
        Err.Raise 9, TypeName(Me) & ".Delete", "Invalid startIndex"
    ElseIf length_ < 0 Then
        Err.Raise 5, TypeName(Me) & ".Delete", "Invalid length_"
    ElseIf length_ = 0 Then
        Exit Sub 'Nothing to delete
    End If
    '
    'Check if a simple shift of the endIndex would suffice
    If startIndex + length_ > m_buffer.endIndex_ Then
        'Ignoring characters that were marked for deletion
        m_buffer.endIndex_ = startIndex - 1
        Exit Sub
    End If
    '
    Dim shiftLength As Long
    '
    shiftLength = m_buffer.endIndex_ - startIndex - length_ + 1
    '
    'Shift Text Left
    Mid$(m_buffer.text_, startIndex, shiftLength) _
         = Mid$(m_buffer.text_, startIndex + length_, shiftLength)
    '
    'Update last character position
    m_buffer.endIndex_ = m_buffer.endIndex_ - length_
End Sub

'*******************************************************************************
'Extend buffer size if needed
'*******************************************************************************
Public Sub EnsureCapacity(ByVal MinimumCapacity As Long)
    'Maximum string length allowed by VBA for a dynamic-length string
    Const MAX_CAPACITY As Long = &H7FFFFFFF '2,147,483,647 (dec)
    '
    If MinimumCapacity > m_buffer.capacity_ Then
        Dim oldCapacity As Long: oldCapacity = m_buffer.capacity_
        '
        'Avoid overflow
        If CDbl(MinimumCapacity) * 2# > CDbl(MAX_CAPACITY) Then
            m_buffer.capacity_ = MAX_CAPACITY
        Else
            m_buffer.capacity_ = MinimumCapacity * 2
        End If
        '
        m_buffer.text_ = m_buffer.text_ & Space$(m_buffer.capacity_ - oldCapacity)
    End If
End Sub

'*******************************************************************************
'Insert new text into buffer
'*******************************************************************************
Public Sub Insert(ByVal startIndex As Long, ByRef textToInsert As String)
    'Validate Input
    If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then
        Err.Raise 9, TypeName(Me) & ".Insert", "Invalid startIndex"
    End If
    '
    Dim addedLength As Long: addedLength = Len(textToInsert)
    If addedLength = 0 Then Exit Sub 'Nothing to insert
    Dim newEndIndex As Long: newEndIndex = m_buffer.endIndex_ + addedLength
    Dim shiftLength As Long: shiftLength = m_buffer.endIndex_ - startIndex + 1
    '
    'EnsureCapacity already checks for: newEndIndex > m_buffer.capacity_
    'When many appends are done (ex. 1 character at a time for a million times)
    '   then the extra 'If' is faster than exiting the scope of this function
    '   i.e. avoid pushing a new stack frame at the top of the call stack
    If newEndIndex > m_buffer.capacity_ Then EnsureCapacity newEndIndex
    '
    'Shift Text Right
    Mid$(m_buffer.text_, startIndex + addedLength, shiftLength) _
        = Mid$(m_buffer.text_, startIndex, shiftLength)
    '
    'Replace unused characters with the new text starting at startIndex
    'The Mid Statement can be used to quickly replace characters
    'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-statement
    Mid$(m_buffer.text_, startIndex, addedLength) = textToInsert
    '
    'Update last character position
    m_buffer.endIndex_ = newEndIndex
End Sub

'*******************************************************************************
'Replace a portion of the buffer with a given text
'*******************************************************************************
Public Sub Replace(ByVal startIndex As Long, ByVal length_ As Long, ByRef replacementText As String)
    'Validate Input
    If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then
        Err.Raise 9, TypeName(Me) & ".Replace", "Invalid startIndex"
    ElseIf length_ < 0 Then
        Err.Raise 5, TypeName(Me) & ".Replace", "Invalid length_"
    ElseIf length_ = 0 Then
        Exit Sub 'Nothing to replace
    End If
    '
    Dim usedLength As Long
    '
    'Compute usable length
    If startIndex + length_ > m_buffer.endIndex_ + 1 Then
        usedLength = m_buffer.endIndex_ + 1 - startIndex
    Else
        usedLength = length_
    End If
    '
    'Replace characters with the new text
    'The Mid Statement can be used to quickly replace characters
    'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-statement
    Mid$(m_buffer.text_, startIndex, usedLength) = replacementText
End Sub

'*******************************************************************************
'Reset buffer members for (re)usage
'*******************************************************************************
Public Sub reset()
    m_buffer.text_ = vbNullString
    m_buffer.endIndex_ = 0
    m_buffer.capacity_ = 0
End Sub

'*******************************************************************************
'Reverses the contained string
'*******************************************************************************
Public Sub Reverse()
    If m_buffer.endIndex_ > 0 Then
        Me.Replace 1, m_buffer.endIndex_, StrReverse(Me.value)
    End If
End Sub

'*******************************************************************************
'Returns a substring
'*******************************************************************************
Public Function Substring(ByVal startIndex As Long, ByVal length_ As Long) As String
    'Validate Input
    If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then
        Err.Raise 9, TypeName(Me) & ".Substring", "Invalid startIndex"
    ElseIf length_ < 0 Then
        Err.Raise 5, TypeName(Me) & ".Substring", "Invalid length_"
    ElseIf length_ = 0 Then
        Exit Function
    End If
    '
    Dim usedLength As Long
    '
    'Compute usable length
    If startIndex + length_ > m_buffer.endIndex_ + 1 Then
        usedLength = m_buffer.endIndex_ + 1 - startIndex
    Else
        usedLength = length_
    End If
    '
    Substring = Mid$(m_buffer.text_, startIndex, usedLength)
End Function

'===============================================================================
'Returns the capacity of the string i.e. total length of buffer
'===============================================================================
Public Property Get Capacity() As Long
    Capacity = m_buffer.capacity_
End Property

'===============================================================================
'Returns the length of the string i.e. total number of used characters
'===============================================================================
Public Property Get Length() As Long
    Length = m_buffer.endIndex_
End Property

'===============================================================================
'Get the Used String
'Default class member. 'strBuffer.Value' can be also called as 'strBuffer'
'Open class in a text editor to see: Attribute [procName].VB_UserMemId = 0
'===============================================================================
Public Property Get value() As String
    If m_buffer.endIndex_ > 0 Then
        value = Left$(m_buffer.text_, m_buffer.endIndex_)
    End If
End Property
 
Lần chỉnh sửa cuối:
hàm Cells e thấy hình như hút data trên lưới của Excel, thời gian sẽ chậm hơn,
nếu đọc khối data này vào bộ nhớ thì xử lý sẽ nhanh hơn
duLieu = Range("B1:B100000").Value
For i=0 to 999999
str(i+1)= duLieu(i ,0)
Next i
Ở bài #7 tôi dùng hàm Transpose và sơ ý không kiểm tra kết quả nên kết quả bị thiếu quá nhiều do Transpose bị giới hạn (độ dài chuỗi kết quả có 260 ngàn).
Làm lại theo gợi ý này thì không thiếu và vẫn nhanh (dộ dài chuỗi hơn 16.8 tr)

1769230777835.png
Trường hợp này của bạn là dữ liệu đã có từ trước và đã biết trước kích thước để chuẩn bị kịch bản ghép chuỗi rồi bạn,
Cám ơn bạn mặc dù vẫn không hiểu lắm.
 
Lần chỉnh sửa cuối:
Ở bài #7 tôi dùng hàm Transpose và sơ ý không kiểm tra kết quả nên kết quả bị thiếu quá nhiều do Transpose bị giới hạn (độ dài chuỗi kết quả có 260 ngàn).
Làm lại theo gợi ý này thì không thiếu và vẫn nhanh (dộ dài chuỗi hơn 16.8 tr)

View attachment 310956

Cám ơn bạn mặc dù vẫn không hiểu lắm.
Ví dụ như thế này đi, với mã giả (pseudo-code) VBA dưới đây:
Mã:
Dim bDataAvailable As Boolean
Dim strResult As String, strTmp As String, strSource As String
strSource = ReadSourceText(nguon_van_ban)
Dim nLine As Long
Do
    bDataAvailable = ParseValue(strSource, strResult, strTmp, nLine)
    strResult = strResult & strTmp
    nLine = nLine + 1
While bDataAvailable
Mã trên thực hiện việc trích xuất chuỗi strTmp từ nguồn văn bản strSource, sau đó ghép chuỗi vào chuỗi tổng tên là strResult, vòng lặp chạy cho đến khi bDataAvailable trả về False thì dừng lại, nên mới nói là trường hợp không biết trước được dữ liệu dài hay ngắn và phải thực hiện bao nhiêu lần ghép chuỗi.
Tình huống này hay gặp với những thư viện chuyên phân tích cú pháp JSON, XML, v.v...
 
Ví dụ như thế này đi, với mã giả (pseudo-code) VBA dưới đây:
Cám ơn bạn, tôi tạm hiểu ý này rồi.
Nói thêm: Bản thân tôi thuộc loại lập trình xử lý theo vụ việc chứ không nghiên cứu chuyên sâu. Giữa 10 giây và 4 giây thì tôi chọn cách viết chỉ chạy 4 giây. Giữa 4 giây và 1 giây thì tôi chọn cách viết chạy 1 giây. Không biết thì tìm tòi cho biết mà khó thì cũng chịu thua. Tuy nhiên giữa 1 giây và 0.5 giây thì tôi cũng chẳng tìm hiểu thêm làm gì vì không đáng (tôi nghĩ vậy, già rồi).
 
VBA có cấp phát vùng nhớ động ák

Dim mang()
ReDim mang(100000) ' Cấp phát vùng nhớ' ... xử lý dữ liệu ...

Dim Phan_tu
Phan_tu = 5000000 ' cấp lại 5000000
ReDim mang(1 to Phan_tu)

Erase mang ' Hủy hoàn toàn mảng và giải phóng bộ nhớ RAM

--------------------code dãn vùng nhớ để data cũ không mất ----------
Mã:
Sub ThemPhanTuVaoCuoi()
    Dim mang() As Variant
    Dim soLuong As Long
   
    ' Bắt đầu với mảng nhỏ
    ReDim mang(1 To 3)
    mang(1) = "A"
    mang(2) = "B"
    mang(3) = "C"
   
    ' Muốn thêm 1 phần tử mới → tăng lên 4 phần tử
    soLuong = UBound(mang) + 1           ' 4
    ReDim Preserve mang(1 To soLuong)    ' ← giữ dữ liệu cũ
   
    mang(4) = "D"                        ' gán giá trị mới
   
    ' Kết quả: A, B, C, D (dữ liệu cũ vẫn còn)
    MsgBox "Phần tử cuối: " & mang(UBound(mang))
End Sub
ReDim Preserve không phải là giữ nguyên mảng ở vị trí cũ trong bộ nhớ rồi nối tiếp vùng nhớ mới vào đâu, mà VBA sẽ làm theo quy trình thế này:
  1. Xác định kích thước mới của mảng.
  2. Tạo một mảng mới theo kích thước chỉ định ở bước 1.
  3. Sao chép nội dung mảng cũ sang mảng mới.
  4. Xóa mảng cũ.
Gọi lệnh ReDim Preserve thường xuyên, đến một lúc mảng phình to kha khá thì sẽ khiến cho mã chạy chậm, ì ạch đáng kể.
 
StringBuilder lớp hiệu suất cao dành cho VBA nói riêng và cho toàn bộ VB

JavaScript:
Option Explicit

'Internal BUFFER Struct
Private Type BUFFER_STRUCT
    text_ As String
    endIndex_ As Long
    capacity_ As Long
End Type

'Class members
Private m_buffer As BUFFER_STRUCT

'*******************************************************************************
'Append new text to buffer
'*******************************************************************************
Public Sub Append(ByVal textToAppend As String)
    Dim addedLength As Long: addedLength = Len(textToAppend)
    If addedLength = 0 Then Exit Sub
    Dim newEndIndex As Long: newEndIndex = m_buffer.endIndex_ + addedLength
    '
    'EnsureCapacity already checks for: newEndIndex > m_buffer.capacity_
    'When many appends are done (ex. 1 character at a time for a million times)
    '   then the extra 'If' is faster than exiting the scope of this function
    '   i.e. avoid pushing a new stack frame at the top of the call stack
    If newEndIndex > m_buffer.capacity_ Then EnsureCapacity newEndIndex
    '
    'Replace unused characters with the new text after the last used position
    'The Mid Statement can be used to quickly replace characters
    'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-statement
    Mid$(m_buffer.text_, m_buffer.endIndex_ + 1, addedLength) = textToAppend
    '
    'Store last character position
    m_buffer.endIndex_ = newEndIndex
End Sub
'*******************************************************************************
'Delete a portion of the text
'*******************************************************************************
Public Sub Delete(ByVal startIndex As Long, ByVal length_ As Long)
    'Validate Input
    If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then
        Err.Raise 9, TypeName(Me) & ".Delete", "Invalid startIndex"
    ElseIf length_ < 0 Then
        Err.Raise 5, TypeName(Me) & ".Delete", "Invalid length_"
    ElseIf length_ = 0 Then
        Exit Sub 'Nothing to delete
    End If
    '
    'Check if a simple shift of the endIndex would suffice
    If startIndex + length_ > m_buffer.endIndex_ Then
        'Ignoring characters that were marked for deletion
        m_buffer.endIndex_ = startIndex - 1
        Exit Sub
    End If
    '
    Dim shiftLength As Long
    '
    shiftLength = m_buffer.endIndex_ - startIndex - length_ + 1
    '
    'Shift Text Left
    Mid$(m_buffer.text_, startIndex, shiftLength) _
         = Mid$(m_buffer.text_, startIndex + length_, shiftLength)
    '
    'Update last character position
    m_buffer.endIndex_ = m_buffer.endIndex_ - length_
End Sub

'*******************************************************************************
'Extend buffer size if needed
'*******************************************************************************
Public Sub EnsureCapacity(ByVal MinimumCapacity As Long)
    'Maximum string length allowed by VBA for a dynamic-length string
    Const MAX_CAPACITY As Long = &H7FFFFFFF '2,147,483,647 (dec)
    '
    If MinimumCapacity > m_buffer.capacity_ Then
        Dim oldCapacity As Long: oldCapacity = m_buffer.capacity_
        '
        'Avoid overflow
        If CDbl(MinimumCapacity) * 2# > CDbl(MAX_CAPACITY) Then
            m_buffer.capacity_ = MAX_CAPACITY
        Else
            m_buffer.capacity_ = MinimumCapacity * 2
        End If
        '
        m_buffer.text_ = m_buffer.text_ & Space$(m_buffer.capacity_ - oldCapacity)
    End If
End Sub

'*******************************************************************************
'Insert new text into buffer
'*******************************************************************************
Public Sub Insert(ByVal startIndex As Long, ByRef textToInsert As String)
    'Validate Input
    If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then
        Err.Raise 9, TypeName(Me) & ".Insert", "Invalid startIndex"
    End If
    '
    Dim addedLength As Long: addedLength = Len(textToInsert)
    If addedLength = 0 Then Exit Sub 'Nothing to insert
    Dim newEndIndex As Long: newEndIndex = m_buffer.endIndex_ + addedLength
    Dim shiftLength As Long: shiftLength = m_buffer.endIndex_ - startIndex + 1
    '
    'EnsureCapacity already checks for: newEndIndex > m_buffer.capacity_
    'When many appends are done (ex. 1 character at a time for a million times)
    '   then the extra 'If' is faster than exiting the scope of this function
    '   i.e. avoid pushing a new stack frame at the top of the call stack
    If newEndIndex > m_buffer.capacity_ Then EnsureCapacity newEndIndex
    '
    'Shift Text Right
    Mid$(m_buffer.text_, startIndex + addedLength, shiftLength) _
        = Mid$(m_buffer.text_, startIndex, shiftLength)
    '
    'Replace unused characters with the new text starting at startIndex
    'The Mid Statement can be used to quickly replace characters
    'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-statement
    Mid$(m_buffer.text_, startIndex, addedLength) = textToInsert
    '
    'Update last character position
    m_buffer.endIndex_ = newEndIndex
End Sub

'*******************************************************************************
'Replace a portion of the buffer with a given text
'*******************************************************************************
Public Sub Replace(ByVal startIndex As Long, ByVal length_ As Long, ByRef replacementText As String)
    'Validate Input
    If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then
        Err.Raise 9, TypeName(Me) & ".Replace", "Invalid startIndex"
    ElseIf length_ < 0 Then
        Err.Raise 5, TypeName(Me) & ".Replace", "Invalid length_"
    ElseIf length_ = 0 Then
        Exit Sub 'Nothing to replace
    End If
    '
    Dim usedLength As Long
    '
    'Compute usable length
    If startIndex + length_ > m_buffer.endIndex_ + 1 Then
        usedLength = m_buffer.endIndex_ + 1 - startIndex
    Else
        usedLength = length_
    End If
    '
    'Replace characters with the new text
    'The Mid Statement can be used to quickly replace characters
    'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-statement
    Mid$(m_buffer.text_, startIndex, usedLength) = replacementText
End Sub

'*******************************************************************************
'Reset buffer members for (re)usage
'*******************************************************************************
Public Sub reset()
    m_buffer.text_ = vbNullString
    m_buffer.endIndex_ = 0
    m_buffer.capacity_ = 0
End Sub

'*******************************************************************************
'Reverses the contained string
'*******************************************************************************
Public Sub Reverse()
    If m_buffer.endIndex_ > 0 Then
        Me.Replace 1, m_buffer.endIndex_, StrReverse(Me.value)
    End If
End Sub

'*******************************************************************************
'Returns a substring
'*******************************************************************************
Public Function Substring(ByVal startIndex As Long, ByVal length_ As Long) As String
    'Validate Input
    If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then
        Err.Raise 9, TypeName(Me) & ".Substring", "Invalid startIndex"
    ElseIf length_ < 0 Then
        Err.Raise 5, TypeName(Me) & ".Substring", "Invalid length_"
    ElseIf length_ = 0 Then
        Exit Function
    End If
    '
    Dim usedLength As Long
    '
    'Compute usable length
    If startIndex + length_ > m_buffer.endIndex_ + 1 Then
        usedLength = m_buffer.endIndex_ + 1 - startIndex
    Else
        usedLength = length_
    End If
    '
    Substring = Mid$(m_buffer.text_, startIndex, usedLength)
End Function

'===============================================================================
'Returns the capacity of the string i.e. total length of buffer
'===============================================================================
Public Property Get Capacity() As Long
    Capacity = m_buffer.capacity_
End Property

'===============================================================================
'Returns the length of the string i.e. total number of used characters
'===============================================================================
Public Property Get Length() As Long
    Length = m_buffer.endIndex_
End Property

'===============================================================================
'Get the Used String
'Default class member. 'strBuffer.Value' can be also called as 'strBuffer'
'Open class in a text editor to see: Attribute [procName].VB_UserMemId = 0
'===============================================================================
Public Property Get value() As String
    If m_buffer.endIndex_ > 0 Then
        value = Left$(m_buffer.text_, m_buffer.endIndex_)
    End If
End Property
Cái class module này thực chất là xuất phát từ kho Github này:
VBA-StringBuffer/Code Modules/StringBuffer.cls
 
Ở các bài viết trên, các bác ấy dùng mảng join lại. Cần nói cho họ hiểu về vấn đề cấp phát bộ nhớ.
Mảng gây tốn kém bộ nhớ, bộ đệm, dẫn đến tốn CPU tính toán. Trong xử lý dữ liệu thì có xử lý dữ liệu lớn và rất lớn. Trong lập trình thì việc tiết kiệm chi phí là điều quan trọng.

Trong VBA có hàm Replace chậm như rùa bò trong việc xử lý chuỗi, thử dùng VBA thay thế sau cũng dựa vào hàm MID
JavaScript:
Public Function Replace08(ByVal text As String, _
            ByVal sOld As String, ByVal sNew As String, _
            Optional ByVal start As Long = 1, _
            Optional ByVal count As Long = 2147483647, _
            Optional ByVal compare As VbCompareMethod = vbBinaryCompare _
            ) As String
  ' 'by Jost Schwider, jost@schwider.de, 20001218
  If LenB(sOld) Then
    If compare = vbBinaryCompare Then
      Replace08Bin Replace08, text, text, sOld, sNew, start, count
    Else
      Replace08Bin Replace08, text, LCase$(text), LCase$(sOld), sNew, start, count
    End If
  Else ''Suchstring ist leer:
    Replace08 = text
  End If
End Function
Private Static Sub Replace08Bin(ByRef result As String, _
            ByRef text As String, ByRef Search As String, _
            ByRef sOld As String, ByRef sNew As String, _
            ByVal start As Long, ByVal count As Long)
  '' by Jost Schwider, jost@schwider.de, 20001218
  Dim TextLen As Long, OldLen As Long, NewLen As Long, ReadPos As Long
  Dim WritePos As Long, CopyLen As Long, buffer As String, BufferLen As Long, BufferPosNew As Long, BufferPosNext As Long
  ''Ersten Treffer bestimmen:
  If start < 2 Then
    start = InStrB(Search, sOld)
  Else
    start = InStrB(start + start - 1, Search, sOld)
  End If
  If start Then
    OldLen = LenB(sOld)
    NewLen = LenB(sNew)
    Select Case NewLen
    Case OldLen ''einfaches Überschreiben:
      result = text
      For count = 1 To count
        MidB$(result, start) = sNew
        start = InStrB(start + OldLen, Search, sOld)
        If start = 0 Then Exit Sub
      Next count
    Case 0 ''nur Entfernen:
      ''Buffer initialisieren:
      TextLen = LenB(text)
      If TextLen > BufferLen Then
        buffer = text
        BufferLen = TextLen
      End If
      ''Ausschneiden:
      ReadPos = 1
      WritePos = 1
      For count = 1 To count
        CopyLen = start - ReadPos
        If CopyLen Then
          MidB$(buffer, WritePos) = MidB$(text, ReadPos, CopyLen)
          WritePos = WritePos + CopyLen
        End If
        ReadPos = start + OldLen
        start = InStrB(ReadPos, Search, sOld)
        If start = 0 Then Exit For
      Next count
      ''Ergebnis zusammenbauen:
      If ReadPos > TextLen Then
        result = LeftB$(buffer, WritePos - 1)
      Else
        MidB$(buffer, WritePos) = MidB$(text, ReadPos)
        result = LeftB$(buffer, WritePos + TextLen - ReadPos)
      End If
      Exit Sub
    Case Is < OldLen 'Ergebnis wird kürzer:
      'Buffer initialisieren:
      TextLen = LenB(text)
      If TextLen > BufferLen Then
        buffer = text
        BufferLen = TextLen
      End If
      'Ersetzen:
      ReadPos = 1
      WritePos = 1
      For count = 1 To count
        CopyLen = start - ReadPos
        If CopyLen Then
          BufferPosNew = WritePos + CopyLen
          MidB$(buffer, WritePos) = MidB$(text, ReadPos, CopyLen)
          MidB$(buffer, BufferPosNew) = sNew
          WritePos = BufferPosNew + NewLen
        Else
          MidB$(buffer, WritePos) = sNew
          WritePos = WritePos + NewLen
        End If
        ReadPos = start + OldLen
        start = InStrB(ReadPos, Search, sOld)
        If start = 0 Then Exit For
      Next count
      'Ergebnis zusammenbauen:
      If ReadPos > TextLen Then
        result = LeftB$(buffer, WritePos - 1)
      Else
        MidB$(buffer, WritePos) = MidB$(text, ReadPos)
        result = LeftB$(buffer, WritePos + LenB(text) - ReadPos)
      End If
      Exit Sub
    Case Else 'Ergebnis wird länger:
      ''Buffer initialisieren:
      TextLen = LenB(text)
      BufferPosNew = TextLen + NewLen
      If BufferPosNew > BufferLen Then
        buffer = Space$(BufferPosNew)
        BufferLen = LenB(buffer)
      End If
      ''Ersetzung:
      ReadPos = 1
      WritePos = 1
      For count = 1 To count
        CopyLen = start - ReadPos
        If CopyLen Then
          ''Positionen berechnen:
          BufferPosNew = WritePos + CopyLen
          BufferPosNext = BufferPosNew + NewLen
          ''Ggf. Buffer vergrößern:
          If BufferPosNext > BufferLen Then
            buffer = buffer & Space$(BufferPosNext)
            BufferLen = LenB(buffer)
          End If
          ''String "patchen":
          MidB$(buffer, WritePos) = MidB$(text, ReadPos, CopyLen)
          MidB$(buffer, BufferPosNew) = sNew
          WritePos = BufferPosNext
        Else
          ''Position bestimmen:
          BufferPosNext = WritePos + NewLen
          ''Ggf. Buffer vergrößern:
          If BufferPosNext > BufferLen Then
            buffer = buffer & Space$(BufferPosNext)
            BufferLen = LenB(buffer)
          End If
          ''String "patchen":
          MidB$(buffer, WritePos) = sNew
          WritePos = BufferPosNext
        End If
        ReadPos = start + OldLen
        start = InStrB(ReadPos, Search, sOld)
        If start = 0 Then Exit For
      Next count
      ''Ergebnis zusammenbauen:
      If ReadPos > TextLen Then
        result = LeftB$(buffer, WritePos - 1)
      Else
        BufferPosNext = WritePos + TextLen - ReadPos
        If BufferPosNext < BufferLen Then
          MidB$(buffer, WritePos) = MidB$(text, ReadPos)
          result = LeftB$(buffer, BufferPosNext)
        Else
          result = LeftB$(buffer, WritePos - 1) & MidB$(text, ReadPos)
        End If
      End If
      Exit Sub
    End Select
    Else ''Kein Treffer:
    result = text
  End If
End Sub
 
Ở các bài viết trên, các bác ấy dùng mảng join lại. Cần nói cho họ hiểu về vấn đề cấp phát bộ nhớ.
Mảng gây tốn kém bộ nhớ, bộ đệm, dẫn đến tốn CPU tính toán. Trong xử lý dữ liệu thì có xử lý dữ liệu lớn và rất lớn. Trong lập trình thì việc tiết kiệm chi phí là điều quan trọng.

Trong VBA có hàm Replace chậm như rùa bò trong việc xử lý chuỗi, thử dùng VBA thay thế sau cũng dựa vào hàm MID
JavaScript:
Public Function Replace08(ByVal text As String, _
            ByVal sOld As String, ByVal sNew As String, _
            Optional ByVal start As Long = 1, _
            Optional ByVal count As Long = 2147483647, _
            Optional ByVal compare As VbCompareMethod = vbBinaryCompare _
            ) As String
  ' 'by Jost Schwider, jost@schwider.de, 20001218
  If LenB(sOld) Then
    If compare = vbBinaryCompare Then
      Replace08Bin Replace08, text, text, sOld, sNew, start, count
    Else
      Replace08Bin Replace08, text, LCase$(text), LCase$(sOld), sNew, start, count
    End If
  Else ''Suchstring ist leer:
    Replace08 = text
  End If
End Function
Private Static Sub Replace08Bin(ByRef result As String, _
            ByRef text As String, ByRef Search As String, _
            ByRef sOld As String, ByRef sNew As String, _
            ByVal start As Long, ByVal count As Long)
  '' by Jost Schwider, jost@schwider.de, 20001218
  Dim TextLen As Long, OldLen As Long, NewLen As Long, ReadPos As Long
  Dim WritePos As Long, CopyLen As Long, buffer As String, BufferLen As Long, BufferPosNew As Long, BufferPosNext As Long
  ''Ersten Treffer bestimmen:
  If start < 2 Then
    start = InStrB(Search, sOld)
  Else
    start = InStrB(start + start - 1, Search, sOld)
  End If
  If start Then
    OldLen = LenB(sOld)
    NewLen = LenB(sNew)
    Select Case NewLen
    Case OldLen ''einfaches Überschreiben:
      result = text
      For count = 1 To count
        MidB$(result, start) = sNew
        start = InStrB(start + OldLen, Search, sOld)
        If start = 0 Then Exit Sub
      Next count
    Case 0 ''nur Entfernen:
      ''Buffer initialisieren:
      TextLen = LenB(text)
      If TextLen > BufferLen Then
        buffer = text
        BufferLen = TextLen
      End If
      ''Ausschneiden:
      ReadPos = 1
      WritePos = 1
      For count = 1 To count
        CopyLen = start - ReadPos
        If CopyLen Then
          MidB$(buffer, WritePos) = MidB$(text, ReadPos, CopyLen)
          WritePos = WritePos + CopyLen
        End If
        ReadPos = start + OldLen
        start = InStrB(ReadPos, Search, sOld)
        If start = 0 Then Exit For
      Next count
      ''Ergebnis zusammenbauen:
      If ReadPos > TextLen Then
        result = LeftB$(buffer, WritePos - 1)
      Else
        MidB$(buffer, WritePos) = MidB$(text, ReadPos)
        result = LeftB$(buffer, WritePos + TextLen - ReadPos)
      End If
      Exit Sub
    Case Is < OldLen 'Ergebnis wird kürzer:
      'Buffer initialisieren:
      TextLen = LenB(text)
      If TextLen > BufferLen Then
        buffer = text
        BufferLen = TextLen
      End If
      'Ersetzen:
      ReadPos = 1
      WritePos = 1
      For count = 1 To count
        CopyLen = start - ReadPos
        If CopyLen Then
          BufferPosNew = WritePos + CopyLen
          MidB$(buffer, WritePos) = MidB$(text, ReadPos, CopyLen)
          MidB$(buffer, BufferPosNew) = sNew
          WritePos = BufferPosNew + NewLen
        Else
          MidB$(buffer, WritePos) = sNew
          WritePos = WritePos + NewLen
        End If
        ReadPos = start + OldLen
        start = InStrB(ReadPos, Search, sOld)
        If start = 0 Then Exit For
      Next count
      'Ergebnis zusammenbauen:
      If ReadPos > TextLen Then
        result = LeftB$(buffer, WritePos - 1)
      Else
        MidB$(buffer, WritePos) = MidB$(text, ReadPos)
        result = LeftB$(buffer, WritePos + LenB(text) - ReadPos)
      End If
      Exit Sub
    Case Else 'Ergebnis wird länger:
      ''Buffer initialisieren:
      TextLen = LenB(text)
      BufferPosNew = TextLen + NewLen
      If BufferPosNew > BufferLen Then
        buffer = Space$(BufferPosNew)
        BufferLen = LenB(buffer)
      End If
      ''Ersetzung:
      ReadPos = 1
      WritePos = 1
      For count = 1 To count
        CopyLen = start - ReadPos
        If CopyLen Then
          ''Positionen berechnen:
          BufferPosNew = WritePos + CopyLen
          BufferPosNext = BufferPosNew + NewLen
          ''Ggf. Buffer vergrößern:
          If BufferPosNext > BufferLen Then
            buffer = buffer & Space$(BufferPosNext)
            BufferLen = LenB(buffer)
          End If
          ''String "patchen":
          MidB$(buffer, WritePos) = MidB$(text, ReadPos, CopyLen)
          MidB$(buffer, BufferPosNew) = sNew
          WritePos = BufferPosNext
        Else
          ''Position bestimmen:
          BufferPosNext = WritePos + NewLen
          ''Ggf. Buffer vergrößern:
          If BufferPosNext > BufferLen Then
            buffer = buffer & Space$(BufferPosNext)
            BufferLen = LenB(buffer)
          End If
          ''String "patchen":
          MidB$(buffer, WritePos) = sNew
          WritePos = BufferPosNext
        End If
        ReadPos = start + OldLen
        start = InStrB(ReadPos, Search, sOld)
        If start = 0 Then Exit For
      Next count
      ''Ergebnis zusammenbauen:
      If ReadPos > TextLen Then
        result = LeftB$(buffer, WritePos - 1)
      Else
        BufferPosNext = WritePos + TextLen - ReadPos
        If BufferPosNext < BufferLen Then
          MidB$(buffer, WritePos) = MidB$(text, ReadPos)
          result = LeftB$(buffer, BufferPosNext)
        Else
          result = LeftB$(buffer, WritePos - 1) & MidB$(text, ReadPos)
        End If
      End If
      Exit Sub
    End Select
    Else ''Kein Treffer:
    result = text
  End If
End Sub
Theo bạn, lý do gì hàm Replace lại chạy chậm như rùa bò?
 
Cái class module này thực chất là xuất phát từ kho Github này:
VBA-StringBuffer/Code Modules/StringBuffer.cls
Tin không ???? !!!!!!!!!!!

Tôi pha ly cafe nhâm nhi cùng ChatGPT khoãng 30 phút to 1 tiếng .........

viết xong các chức năng như Class module có trên Github là DLL COM C++ builder hay hơn nhiều lần và siêu nhanh không ????

thay vì VBA vốn dĩ cùi bắp rồi còn tái chế các kiểu viết trên cái nền cùi đó lấy gì ra Nhanh !!!!!!!!!!!!??????????

xong từ bộ khung đó viết thêm cả đống hàm tiện ích tuỳ chỉnh các kiểu nhẹ như lông vịt bay trong gió
 
Lần chỉnh sửa cuối:
Tin không ???? !!!!!!!!!!!

Tôi pha ly cafe nhâm nhi cùng ChatGPT khoãng 30 phút to 1 tiếng .........

viết xong các chức năng như Class module có trên Github là DLL COM C++ builder hay hơn nhiều lần và siêu nhanh không ????

thay vì VBA vốn dĩ cùi bắp rồi còn tái chế các kiểu viết trên cái nền cùi đó lấy gì ra Nhanh !!!!!!!!!!!!??????????

xong từ bộ khung đó viết thêm cả đống hàm tiện ích tuỳ chỉnh các kiểu nhẹ như lông vịt bay trong gió
Ông thử viết xong, chia sẻ lên đây để mọi người xem có gì cải tiến so với mã viết bằng VBA không.
 
Ông thử viết xong, chia sẻ lên đây để mọi người xem có gì cải tiến so với mã viết bằng VBA không.
OK viết cho Xem mà sáng nay đang bận nên chỉ à ơi chút ... chiều dò viết khung xong mai mốt úp cho thử chơi ... nhìn qua thấy đơn giản thôi

Viết COM DLL là C++ Builder cho nó hoành tráng như ai cho vui
 
ReDim Preserve không phải là giữ nguyên mảng ở vị trí cũ trong bộ nhớ rồi nối tiếp vùng nhớ mới vào đâu, mà VBA sẽ làm theo quy trình thế này:
  1. Xác định kích thước mới của mảng.
  2. Tạo một mảng mới theo kích thước chỉ định ở bước 1.
  3. Sao chép nội dung mảng cũ sang mảng mới.
  4. Xóa mảng cũ.
Gọi lệnh ReDim Preserve thường xuyên, đến một lúc mảng phình to kha khá thì sẽ khiến cho mã chạy chậm, ì ạch đáng kể.

Mình cũng không rành về cấp phát bộ nhớ lắm !
nhưng dựa vào phân tích ở bài 1, mình cũng hiểu cách thức tính toán và có thể ước lượng số lượng công việc máy tính phải làm !


Với cú pháp str = str & "a"

vòng lặp 1 khởi tạo bộ nhớ gán a : a
vòng lặp 2 copy toàn bộ 1 sang vùng mới + thêm 1 a : aa
vòng lặp 3 copy toàn bộ 2 sang vùng mới + thêm 1 a : aaa
vòng lặp 4 copy toàn bộ 3 sang vùng mới + thêm 1 a : aaaa
vòng lặp 5 copy toàn bộ 4 sang vùng mới + thêm 1 a : aaaaa
vòng lặp 6 copy toàn bộ 5 sang vùng mới + thêm 1 a : aaaaaa
vòng lặp 7 copy toàn bộ 6 sang vùng mới + thêm 1 a : aaaaaaa
vòng lặp 8 copy toàn bộ 7 sang vùng mới + thêm 1 a : aaaaaaaa
vòng lặp 9 copy toàn bộ 8 sang vùng mới + thêm 1 a : aaaaaaaaa

phần tô đỏ là phần tính toán dư thừa, được nhân lên theo cấp mũ theo mỗi vòng lặp

vấn đề là giờ tìm cách bỏ phần tính toán dư thừa đi, nếu để thành 1 mảng aaaaaaaaaa
và nối thành 1 chuỗi hoàn chỉnh bằng hàm Join, thì độ phức tạp bài toán chỉ còn n*2, nếu làm bằng C hay thuật toán nào đó nhỏ hơn n*2 thì chương trình sẽ chạy nhanh hơn !
 
Mình cũng không rành về cấp phát bộ nhớ lắm !
nhưng dựa vào phân tích ở bài 1, mình cũng hiểu cách thức tính toán và có thể ước lượng số lượng công việc máy tính phải làm !


Với cú pháp str = str & "a"

vòng lặp 1 khởi tạo bộ nhớ gán a : a
vòng lặp 2 copy toàn bộ 1 sang vùng mới + thêm 1 a : aa
vòng lặp 3 copy toàn bộ 2 sang vùng mới + thêm 1 a : aaa
vòng lặp 4 copy toàn bộ 3 sang vùng mới + thêm 1 a : aaaa
vòng lặp 5 copy toàn bộ 4 sang vùng mới + thêm 1 a : aaaaa
vòng lặp 6 copy toàn bộ 5 sang vùng mới + thêm 1 a : aaaaaa
vòng lặp 7 copy toàn bộ 6 sang vùng mới + thêm 1 a : aaaaaaa
vòng lặp 8 copy toàn bộ 7 sang vùng mới + thêm 1 a : aaaaaaaa
vòng lặp 9 copy toàn bộ 8 sang vùng mới + thêm 1 a : aaaaaaaaa

phần tô đỏ là phần tính toán dư thừa, được nhân lên theo cấp mũ theo mỗi vòng lặp

vấn đề là giờ tìm cách bỏ phần tính toán dư thừa đi, nếu để thành 1 mảng aaaaaaaaaa
và nối thành 1 chuỗi hoàn chỉnh bằng hàm Join, thì độ phức tạp bài toán chỉ còn n*2, nếu làm bằng C hay thuật toán nào đó nhỏ hơn n*2 thì chương trình sẽ chạy nhanh hơn !

Khi viết bài toán cụ thể, tốc độ nhanh chậm phụ thuộc vào giải thuật giải quyết bài toán đó nhiều lắm.
Ví dụ về ReDim Preserve.
Nếu bạn thay đổi kích thước mảng mỗi khi thêm 1 phần tử mảng trong vòng lặp sẽ bị chậm là đương nhiên, không phải chỉ VBA mà các ngôn ngữ khác cũng vậy. Giải thuật để tốc độ nhanh là:
1. Ước tính tạm số phần tử mảng. Ví dụ dụ 1000 phần tử ta làm một nhát tạo kích thước 1000 luôn
2. Trong logic nhận giá trị nếu số phần tử mảng > 1000 thì mới tăng kích thước mảng lên 1000 nữa. Cần cần lo lắng về dư thừa đâu - Đây là đánh đổi tạm để đạt tốc độ, sau tính toán rồi giải phóng hoàn trả lại cái thừa cho hệ thống.
3. Hết chu trình nhận giá trị cho mảng thì kiểm tra số phần tử thực tế rồi co giãn mảng lần cuối.
Ví dụ minh họa:
Mã:
Sub RedimFast()
    Const Capacity = 1000
    Dim I&, n&, Total&
    Total = Capacity
    ReDim arr(Total) As String
    n = 0
    For I = 1 To 1500
        If True Then 'Giả đinh một điều kiện nào đó cần kiểm tra
            n = n + 1
            If n > Total Then
                Total = Total + Capacity
                ReDim Preserve arr(Total) As String
            End If
            arr(n - 1) = "a" & n
        End If
    Next
    If UBound(arr) >= n Then
        ReDim Preserve arr(n - 1)
    End If
End Sub
 
Mình cũng không rành về cấp phát bộ nhớ lắm !
nhưng dựa vào phân tích ở bài 1, mình cũng hiểu cách thức tính toán và có thể ước lượng số lượng công việc máy tính phải làm !


Với cú pháp str = str & "a"

vòng lặp 1 khởi tạo bộ nhớ gán a : a
vòng lặp 2 copy toàn bộ 1 sang vùng mới + thêm 1 a : aa
vòng lặp 3 copy toàn bộ 2 sang vùng mới + thêm 1 a : aaa
vòng lặp 4 copy toàn bộ 3 sang vùng mới + thêm 1 a : aaaa
vòng lặp 5 copy toàn bộ 4 sang vùng mới + thêm 1 a : aaaaa
vòng lặp 6 copy toàn bộ 5 sang vùng mới + thêm 1 a : aaaaaa
vòng lặp 7 copy toàn bộ 6 sang vùng mới + thêm 1 a : aaaaaaa
vòng lặp 8 copy toàn bộ 7 sang vùng mới + thêm 1 a : aaaaaaaa
vòng lặp 9 copy toàn bộ 8 sang vùng mới + thêm 1 a : aaaaaaaaa

phần tô đỏ là phần tính toán dư thừa, được nhân lên theo cấp mũ theo mỗi vòng lặp

vấn đề là giờ tìm cách bỏ phần tính toán dư thừa đi, nếu để thành 1 mảng aaaaaaaaaa
và nối thành 1 chuỗi hoàn chỉnh bằng hàm Join, thì độ phức tạp bài toán chỉ còn n*2, nếu làm bằng C hay thuật toán nào đó nhỏ hơn n*2 thì chương trình sẽ chạy nhanh hơn !
Sở dĩ bạn thấy chứa từng chuỗi được ghép trong mảng của VBA thì nhanh so với #1 là vì mỗi phần tử của mảng chỉ chứa con trỏ (địa chỉ vùng nhớ) trỏ đến vùng nhớ của chuỗi mà thôi, chúng nó nằm rải rác trên bộ nhớ chứ không nằm liền kề nhau trong vùng nhớ liên tục giống như #1.
Nếu chỉ nối chuỗi thôi thì ổn đấy, nhưng khi cần chỉnh sửa, xóa, thêm bớt chuỗi thì phải làm thế nào khi mỗi chuỗi nằm mỗi nơi, xác định vị trí của ký tự/chuỗi như thế nào, cho nên ý tưởng dùng mảng của VBA để làm trình xây dựng chuỗi là không khả thi cho lắm.
Thật ra ở #1 có thể giúp mã chạy nhanh hơn ở giai đoạn sử dụng hàm HeapReAlloc xin cấp phát thêm bộ nhớ từ hệ điều hành, tham số dwFlags của hàm này cho phép bật một cờ bit tên là HEAP_REALLOC_IN_PLACE_ONLY (0x00000010), trong đó tài liệu của Microsoft có giải thích:
1769393789345.png
Tức là khi bật cờ bit này để gọi hàm HeapReAlloc, hệ điều hành thay vì tìm một vùng nhớ liên tục ở vị trí nào đó trong RAM rồi sao chép dữ liệu vùng nhớ cũ sang vùng nhớ mới tốn nhiều thời gian và công sức, thì hệ điều hành lại giữ nguyên vùng nhớ cũ và chỉ cần mở rộng thêm không gian cho vùng nhớ cũ là xong. Tuy nhiên nếu không gian để mở rộng vùng nhớ cũ lại có vùng nhớ nào đó khác đã chiếm cứ từ trước thì hàm HeapReAlloc trả về NULL, tức là không thể thực hiện việc cấp phát thêm vùng nhớ và vùng nhớ cũ vẫn giữ nguyên. Tình huống này có thể xảy ra bất cứ lúc nào, không đoán trước được, nên nhiều người hay thắc mắc thế quái nào dung lượng RAM vẫn còn thừa mà sao không thể xin cấp phát thêm được với cờ bit này.
 
Sở dĩ bạn thấy chứa từng chuỗi được ghép trong mảng của VBA thì nhanh so với #1 là vì mỗi phần tử của mảng chỉ chứa con trỏ (địa chỉ vùng nhớ) trỏ đến vùng nhớ của chuỗi mà thôi, chúng nó nằm rải rác trên bộ nhớ chứ không nằm liền kề nhau trong vùng nhớ liên tục giống như #1.
Nếu chỉ nối chuỗi thôi thì ổn đấy, nhưng khi cần chỉnh sửa, xóa, thêm bớt chuỗi thì phải làm thế nào khi mỗi chuỗi nằm mỗi nơi, xác định vị trí của ký tự/chuỗi như thế nào, cho nên ý tưởng dùng mảng của VBA để làm trình xây dựng chuỗi là không khả thi cho lắm.
Thật ra ở #1 có thể giúp mã chạy nhanh hơn ở giai đoạn sử dụng hàm HeapReAlloc xin cấp phát thêm bộ nhớ từ hệ điều hành, tham số dwFlags của hàm này cho phép bật một cờ bit tên là HEAP_REALLOC_IN_PLACE_ONLY (0x00000010), trong đó tài liệu của Microsoft có giải thích:
View attachment 310962
Tức là khi bật cờ bit này để gọi hàm HeapReAlloc, hệ điều hành thay vì tìm một vùng nhớ liên tục ở vị trí nào đó trong RAM rồi sao chép dữ liệu vùng nhớ cũ sang vùng nhớ mới tốn nhiều thời gian và công sức, thì hệ điều hành lại giữ nguyên vùng nhớ cũ và chỉ cần mở rộng thêm không gian cho vùng nhớ cũ là xong. Tuy nhiên nếu không gian để mở rộng vùng nhớ cũ lại có vùng nhớ nào đó khác đã chiếm cứ từ trước thì hàm HeapReAlloc trả về NULL, tức là không thể thực hiện việc cấp phát thêm vùng nhớ và vùng nhớ cũ vẫn giữ nguyên. Tình huống này có thể xảy ra bất cứ lúc nào, không đoán trước được, nên nhiều người hay thắc mắc thế quái nào dung lượng RAM vẫn còn thừa mà sao không thể xin cấp phát thêm được với cờ bit này.
Việc chèn thêm phần tử thì mình cũng hay làm , và thấy cũng hiệu quả, chỉ cần làm mảng 2 chiều thôi,

ví dụ : có mảng 2 chiều , cột 1 là số lượng chèn,
{1} {a} { } { }
{1} {a} { } { }
{1} {a} { } { }
{1} {a} { } { }

chèn b vào vị trí thứ 2 , 3
{1} {a} { } { }
{2} {a} {b} { }
{2} {a} {b} { }
{1} {a} { } { }

chèn c vào vị trí thứ 3

{1} {a} { } { }
{2} {a} {b} { }
{3} {a} {b} {c}
{1} {a} { } { }

nối thành 1 chuỗi hoàn chỉnh !
{a}{a}{b}{a}{b}{c}{a} => Join aababca

tổng cộng tạo data gốc , nối thành chuỗi lớn, join cũng cần 7 * 3 phép tính , không có phép tính trùng !
 
Lần chỉnh sửa cuối:
Việc chèn thêm phần tử thì mình cũng hay làm , và thấy cũng hiệu quả, chỉ cần làm mảng 2 chiều thôi,

ví dụ : có mảng 2 chiều , cột 1 là số lượng chèn,
{1} {a} { } { }
{1} {a} { } { }
{1} {a} { } { }
{1} {a} { } { }

chèn b vào vị trí thứ 2 , 3
{1} {a} { } { }
{2} {a} {b} { }
{2} {a} {b} { }
{1} {a} { } { }

chèn c vào vị trí thứ 3

{1} {a} { } { }
{2} {a} {b} { }
{3} {a} {b} {c}
{1} {a} { } { }

nối thành 1 chuỗi hoàn chỉnh !
aababca
tổng cộng nối chuỗi cũng cần 7 phép tính , không có phép tính trùng !
Bạn thử ReDim Preserve cái mảng hai chiều đó xem có được không nhé.
 
ReDim Preserve như phân tích ở trên, thì bản chất cũng là cấp phát 1 vùng nhớ hoàn toàn mới và copy data sang vùng nhớ mới thôi,
kết hợp ý tưởng bài #23
sau khi data tăng thêm , thì lại cấp phát lại vùng nhớ , nới ra thêm 1000 đơn vị , copy thủ công quan thôi !

ReDim temp1(1 To 10, 1 To 1000)

nếu data tăng thêm thì + thêm 1000
ReDim temp2(1 To 10, 1 To 2000)
dùng vòng for 2 chiều copy temp1 sang temp2 ( công việc này ReDim Preserve làm, có thể nhanh hơn ReDim Preserve vì mình đã biết số phần tử chèn thêm )
giải phóng vùng nhớ Temp1

nếu data tăng thêm thì + thêm 1000
ReDim temp1(1 To 10, 1 To 3000)
dùng vòng for 2 chiều copy temp2 sang temp1 ( công việc này ReDim Preserve làm )
giải phóng vùng nhớ Temp1

phép tính trùng xuất hiện sau mỗi lần thêm 1000 phần tử !
mà xử lý các tác vụ office thì hiếm khi xuất hiện các trường hợp mảng động lắm, vì căn bản là VBA xử lý đơn luồng tuần tự, không như các bài toán đa luồng gặp trên C++, nếu làm các ứng dụng như game online , các User đăng nhập vào ra liên tục , xử lý nhiều tác vụ song song, mới thể hiện rõ được sức mạnh của việc quản lý bộ nhớ, chèn , giải phóng ..v..v...
 
Lần chỉnh sửa cuối:
ReDim Preserve như phân tích ở trên, thì bản chất cũng là cấp phát 1 vùng nhớ hoàn toàn mới và copy data sang vùng nhớ mới thôi,
kết hợp ý tưởng bài #23
sau khi data tăng thêm , thì lại cấp phát lại vùng nhớ , nới ra thêm 1000 đơn vị , copy thủ công quan thôi !

ReDim temp1(1 To 10, 1 To 1000)

nếu data tăng thêm thì + thêm 1000
ReDim temp2(1 To 10, 1 To 2000)
dùng vòng for 2 chiều copy temp1 sang temp2 ( công việc này ReDim Preserve làm, có thể nhanh hơn ReDim Preserve vì mình đã biết số phần tử chèn thêm )
giải phóng vùng nhớ Temp1

nếu data tăng thêm thì + thêm 1000
ReDim temp1(1 To 10, 1 To 3000)
dùng vòng for 2 chiều copy temp2 sang temp1 ( công việc này ReDim Preserve làm )
giải phóng vùng nhớ Temp1

phép tính trùng xuất hiện sau mỗi lần thêm 1000 phần tử !
mà xử lý các tác vụ office thì hiếm khi xuất hiện các trường hợp mảng động lắm, vì căn bản là VBA xử lý đơn luồng tuần tự, không như các bài toán đa luồng gặp trên C++, nếu làm các ứng dụng như game online , các User đăng nhập vào ra liên tục , xử lý nhiều tác vụ song song, mới thể hiện rõ được sức mạnh của việc quản lý bộ nhớ, chèn , giải phóng ..v..v...
Trông rối rắm thật sự, dùng mảng hai chiều để quản lý, mỗi lần mở rộng mất thời gian sao chép dữ liệu qua lại, lúc Join thì phải duyệt qua từng hàng của mảng hai chiều đó, sau đó lại phải nối lại các kết quả với nhau để ra kết quả tổng, ấy là chưa tính lòi ra thêm một chiều nữa thì cũng ngốn thêm kha khá bộ nhớ chỉ để quản lý vị trí/độ dài của chuỗi nối vào.
Với vùng nhớ liên tục thì chẳng cần phải rắc rối như vậy, việc xác định vị trí chèn chuỗi, sửa, thay thế và xóa chuỗi rất đơn giản., dùng memcpy với memmove là đơn giản nhất.
 
việc chèn chuỗi , thay thế như giải thích thì nghe có vẻ lạc quan, nhưng mình nghĩ là nó không nằm ngoài các thuật toán tìm kiếm , sắp xếp ^^, nếu là data phân tán, thì kiểu gì cũng có 1 mảng quả lý các địa chỉ , nếu là data tuần tự , muốn chèn thêm ở giữa thì kiểu gì cũng dịch các data về phía bên trái hoặc phải, nói chung quản lý cách nào thì mảng VBA cũng quản lý được !
 
Bác hiểu sai về cách quản lý bộ nhớ. Khi nối chuỗi. Việc cấp phát tối thiểu là chỉ cần một vùng nhớ, tối đa là hai vùng nhớ mới nếu vùng nhớ cấp phát chưa đủ lớn. Còn với mảng, bác đã cấp phát 1.000.000 vùng nhớ cho mỗi chuỗi. Sau đó bác dùng hàm Join để nối lại 1.000.000 vùng nhớ đó.
Khi bác thực hiện gán chuỗi, máy sẽ buộc phải thực thi gán chuỗi, một lần nữa lại tạo một vùng nhớ mới gán chuỗi, và thay vùng nhớ thành viên của mảng thành vùng nhớ mới. Thành ra sẽ mất thêm 1.000.000 lần tạo vùng nhớ nữa.

Nếu bác sử dụng một chuỗi đã được cấp phát 10 triệu byte. Sử dụng hàm MID để gán giá trị. Thì không có hành động cấp phát bộ nhớ mới.
Nếu xử lý dữ liệu lớn, chạy đa luồng để xử lý song song. Chắc chắn không đủ bộ nhớ. Lập trình tiết kiệm chi phí, để đảm bảo mã có thể chạy trên nhiều máy gồm những máy yếu, và tài nguyên thấp.

Hiện tại thế giới đang thiếu RAM trầm trọng. Giá tăng cao. Cách duy nhất là tối ưu hóa mã nguồn.
 
@nguyendang95

Nổi hứng viết chơi từ lúc gần 10h tới giờ khoãng gần 2 tiếng nó ra một đống hàm trên C++ Builder

bài kiểu này viết COM DLL là chuẩn nhất và dễ viết nhất nó còn dễ hơn viết thuần VBA vì có nhiều thư viện dựng sẳn và tối ưu theo thời gian về chuỗi cho C++ hay C++ Builder rồi

xem hình ... chiều test lại có thể mai hay mốt lập thớt khác úp chơi

1769401984925.png


Code cơ bản là vậy còn có hằng hà xa hàm tiện ích khác nếu thích viết thêm phút mốt

Mã:
Sub Full_Buffer_Test()
    Dim buff As StringBuffer
    Set buff = New StringBuffer

    buff.Append "ABFGH"
    Debug.Print buff.Value

    buff.Insert 3, "CDE"
    Debug.Print buff.Value

    buff.Reverse
    Debug.Print buff.Value

    buff.Replace 2, 2, "XX"
    Debug.Print buff.Value

    buff.Reverse
    Debug.Print buff.Value

    buff.Delete 6, 2
    Debug.Print buff.Value

    Debug.Print buff.Substring(2, 3)
End Sub
 
Ai quan tâm qua link sau bà tám tiếp ... mai mốt rảnh úp file sau vì còn tinh chỉnh lại chút ... cơ bản viết nhanh và hoàn thành chớp nhoáng sau hai Giờ bà tám cùng ChatGPT

 
Nếu mọi người thắc mắc vì sao DLL trong bài viết bằng C++ tối ưu hết mức rồi mà vì sao khi chạy trong VBA vẫn chậm thì là do chính bản thân VBA nhé. Khi chạy mã C++ theo logic của mã VBA trong #1 thì thời gian chạy xong thậm chí còn chưa đến 0,1 giây.
 
Quên mất, mã C++ ở #1 có hai chỗ sai cần phải sửa lại:
  1. hObject->dwCapacity += dwNewCapacity; sửa thành hObject->dwCapacity = dwNewCapacity; (sai giá trị kích thước tính bằng byte hiện tại của bộ đệm).
  2. memcpy_s(&(hObject->buffer[hObject->dwccharacters]), (hObject->dwCapacity / sizeof(wchar_t)) - hObject->dwccharacters, lpwstrValue, len * sizeof(wchar_t)); sửa thành memcpy_s(&(hObject->buffer[hObject->dwccharacters]), (hObject->dwCapacity - (hObject->dwccharacters * sizeof(wchar_t)), lpwstrValue, len * sizeof(wchar_t)); (sai cách tính số byte còn trống còn lại của bộ đệm).
Do bài #1 không sửa được nữa nên để lại ghi chú ở đây cho những ai cần.
 
Quên mất, mã C++ ở #1 có hai chỗ sai cần phải sửa lại:
  1. hObject->dwCapacity += dwNewCapacity; sửa thành hObject->dwCapacity = dwNewCapacity; (sai giá trị kích thước tính bằng byte hiện tại của bộ đệm).
  2. memcpy_s(&(hObject->buffer[hObject->dwccharacters]), (hObject->dwCapacity / sizeof(wchar_t)) - hObject->dwccharacters, lpwstrValue, len * sizeof(wchar_t)); sửa thành memcpy_s(&(hObject->buffer[hObject->dwccharacters]), (hObject->dwCapacity - (hObject->dwccharacters * sizeof(wchar_t)), lpwstrValue, len * sizeof(wchar_t)); (sai cách tính số byte còn trống còn lại của bộ đệm).
Do bài #1 không sửa được nữa nên để lại ghi chú ở đây cho những ai cần.
khó hiểu chúng nó quản lý kiểu gì bài viết xong vài hôm khoá luôn ???!!! không cho chỉnh sửa
 
khó hiểu chúng nó quản lý kiểu gì bài viết xong vài hôm khoá luôn ???!!! không cho chỉnh sửa
Việc không cho chỉnh sửa bài cũ là có nguyên do từ nhiều năm trước, và "chúng nó" (trong đó có tôi) đã thống nhất chỉ cho sửa trong vòng 24 tiếng (không nhớ chắc con số). Tuy nhiên thành viên có 1 số lượng bài bao nhiêu đó trở lên, vẫn có quyền sửa.
Ghi chú: Bây giờ trí nhớ kém không chắc con số, nhưng quy định như vậy là có thật. Một trong số các phàn nàn lúc bấy giờ là tình trạng tự ý sửa bài, xóa bài, chưa nói đến việc công kích sai rồi sửa lại để cãi các kiểu.
Thử nghĩ một người nêu ra 1 vấn đề, khi được trả lời và được đáp ứng liền xóa bài của mình, thế là các bài phía dưới trở thành vô duyên!
Thôi thì mọi người thông cảm cho "chúng nó".
 
Lần chỉnh sửa cuối:

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

Back
Top Bottom