VBA矩阵类开发：如何运行时根据输入更改数组数据类型？

问题分析 #

你当前的代码存在两个关键问题：

1. 在Select Case分支内声明的p_Array是局部变量，仅在当前分支块内有效，执行完分支后就会被销毁，无法持久存储矩阵数据。
2. VBA模块级变量的类型是编译时确定的，无法在运行时动态切换类型，所以没法用同一个模块级变量兼容不同数据类型。

如果要避免使用Variant（Variant会额外存储类型信息，增加内存开销），可以通过手动管理内存+指针操作的方式实现，核心思路是用一个存储内存地址的变量（LongPtr）指向不同类型的内存块，通过内存拷贝来读写数据。

实现方案 #

1. 类模块声明部分 #

首先在类模块顶部声明API函数和模块级变量，确保32位/64位VBA兼容性：

Option Explicit

Private p_Row As Integer
Private p_Column As Integer
Private p_DataType As String
Private p_DataPtr As LongPtr ' 存储矩阵数据的内存块地址，替代Variant数组

' 内存操作API声明
#If VBA7 Then
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If

Private Const GMEM_ZEROINIT As Long = &H40 ' 分配内存时初始化所有字节为0

2. Initialize方法实现 #

根据指定的数据类型计算内存大小，分配对应内存块：

Public Sub Initialize(ByVal Row As Integer, ByVal Column As Integer, ByVal DataType As String)
    Dim elementSize As Long
    Dim totalBytes As LongPtr
    
    ' 先释放已存在的内存，避免泄漏
    If p_DataPtr <> 0 Then
        GlobalFree p_DataPtr
        p_DataPtr = 0
    End If
    
    p_Row = Row
    p_Column = Column
    p_DataType = DataType
    
    ' 确定对应数据类型的单元素字节数
    Select Case DataType
        Case "Integer": elementSize = 2
        Case "Single": elementSize = 4
        Case "Double": elementSize = 8
        Case "Long": elementSize = 4
        Case "LongLong": elementSize = 8
        Case Else
            AL_Error_Print 7, 1, "AL_Matrix"
            AL_Error_Show 7, 1, "AL_Matrix"
            Exit Sub
    End Select
    
    ' 计算总内存需求（转换为Long避免整数溢出）
    totalBytes = CLng(Row) * CLng(Column) * elementSize
    
    ' 分配并初始化内存
    p_DataPtr = GlobalAlloc(GMEM_ZEROINIT, totalBytes)
    If p_DataPtr = 0 Then
        ' 处理内存分配失败的情况
        AL_Error_Print 7, 2, "AL_Matrix"
        AL_Error_Show 7, 2, "AL_Matrix"
    End If
End Sub

3. 元素读写方法 #

通过CopyMemory操作内存块，实现不同类型数据的读写：

' 设置矩阵指定位置的元素值
Public Sub SetElement(ByVal Row As Integer, ByVal Column As Integer, ByVal Value As Variant)
    Dim elementSize As Long
    Dim offset As LongPtr
    
    If p_DataPtr = 0 Then Exit Sub ' 未初始化直接退出
    
    ' 计算目标元素在内存块中的偏移量（假设行列从0开始）
    Select Case p_DataType
        Case "Integer": elementSize = 2
        Case "Single": elementSize = 4
        Case "Double": elementSize = 8
        Case "Long": elementSize = 4
        Case "LongLong": elementSize = 8
        Case Else: Exit Sub
    End Select
    offset = (CLng(Row) * CLng(p_Column) + CLng(Column)) * elementSize
    
    ' 根据数据类型转换值并写入内存
    Select Case p_DataType
        Case "Integer"
            CopyMemory ByVal p_DataPtr + offset, CInt(Value), elementSize
        Case "Single"
            CopyMemory ByVal p_DataPtr + offset, CSng(Value), elementSize
        Case "Double"
            CopyMemory ByVal p_DataPtr + offset, CDbl(Value), elementSize
        Case "Long"
            CopyMemory ByVal p_DataPtr + offset, CLng(Value), elementSize
        Case "LongLong"
            CopyMemory ByVal p_DataPtr + offset, CLngLng(Value), elementSize
    End Select
End Sub

' 获取矩阵指定位置的元素值
Public Function GetElement(ByVal Row As Integer, ByVal Column As Integer) As Variant
    Dim elementSize As Long
    Dim offset As LongPtr
    Dim tempInt As Integer
    Dim tempSingle As Single
    Dim tempDouble As Double
    Dim tempLong As Long
    Dim tempLongLong As LongLong
    
    If p_DataPtr = 0 Then Exit Function ' 未初始化直接退出
    
    ' 计算目标元素的内存偏移量
    Select Case p_DataType
        Case "Integer": elementSize = 2
        Case "Single": elementSize = 4
        Case "Double": elementSize = 8
        Case "Long": elementSize = 4
        Case "LongLong": elementSize = 8
        Case Else: Exit Function
    End Select
    offset = (CLng(Row) * CLng(p_Column) + CLng(Column)) * elementSize
    
    ' 从内存读取值并返回
    Select Case p_DataType
        Case "Integer"
            CopyMemory tempInt, ByVal p_DataPtr + offset, elementSize
            GetElement = tempInt
        Case "Single"
            CopyMemory tempSingle, ByVal p_DataPtr + offset, elementSize
            GetElement = tempSingle
        Case "Double"
            CopyMemory tempDouble, ByVal p_DataPtr + offset, elementSize
            GetElement = tempDouble
        Case "Long"
            CopyMemory tempLong, ByVal p_DataPtr + offset, elementSize
            GetElement = tempLong
        Case "LongLong"
            CopyMemory tempLongLong, ByVal p_DataPtr + offset, elementSize
            GetElement = tempLongLong
    End Select
End Function

4. 内存释放（类销毁时） #

在类的Terminate事件中释放内存，避免内存泄漏：

Private Sub Class_Terminate()
    If p_DataPtr <> 0 Then
        GlobalFree p_DataPtr
        p_DataPtr = 0
    End If
End Sub

方案优势 #

• 完全避免了Variant类型的额外内存开销，仅分配对应数据类型所需的内存大小。
• 用单个LongPtr变量统一管理不同类型的内存块，符合你"单个变量兼容不同数据类型"的需求。
• 手动内存管理可以精确控制内存分配和释放，减少不必要的内存占用。

内容的提问来源于stack exchange，提问作者Almesi