VBA动态调整二维数组尺寸实现Insert Into语句生成

方案概述 #

从creator表提取区域标识，动态获取对应表的列名，用可调整尺寸的二维数组存储，最终生成通用Insert语句，替代静态数组的局限性。

1. 提取区域标识（从creator表） #

用ADO查询去重的区域值，避免硬编码：

Dim conn As ADODB.Connection, rsAreas As ADODB.Recordset
Set conn = New ADODB.Connection
conn.Open "YOUR_CONNECTION_STRING" '替换为实际数据库连接串

'获取目标区域（可去掉WHERE条件获取所有有效区域）
Set rsAreas = conn.Execute("SELECT DISTINCT area FROM creator WHERE area IN (65,66,80)")

2. 动态二维数组构建 #

先统计区域总数，再针对每个区域查询列名并动态扩展数组：

注：ReDim Preserve仅支持调整最后一维，因此设计数组为(列索引, 区域索引)，方便扩展列数

Dim areaCols() As Variant, areaCount As Integer, colCount As Integer
Dim currentArea As String, rsCols As ADODB.Recordset

'统计区域数量
areaCount = 0
Do While Not rsAreas.EOF: areaCount = areaCount + 1: rsAreas.MoveNext: Loop
rsAreas.MoveFirst

'初始化数组，后续动态扩展列数
ReDim areaCols(0 To 0, 0 To areaCount - 1)
areaCount = 0

Do While Not rsAreas.EOF
    currentArea = rsAreas("area").Value
    '查询对应表的列名（以SQL Server为例，Access需替换为MSysObjects查询）
    Set rsCols = conn.Execute("SELECT COLUMN_NAME FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_NAME = 'table_" & currentArea & "'")
    
    '存储区域标识到数组首列
    areaCols(0, areaCount) = currentArea
    colCount = 1
    
    Do While Not rsCols.EOF
        '动态扩展列数
        If colCount > UBound(areaCols, 1) Then
            ReDim Preserve areaCols(0 To colCount, 0 To UBound(areaCols, 2))
        End If
        areaCols(colCount, areaCount) = rsCols("COLUMN_NAME").Value
        colCount = colCount + 1
        rsCols.MoveNext
    Loop
    
    areaCount = areaCount + 1
    rsCols.Close
Loop

rsAreas.Close: conn.Close

3. 生成Insert Into语句 #

遍历数组拼接列名和参数占位符：

Dim insertStmt As String, colList As String
Dim i As Integer, j As Integer

For i = 0 To UBound(areaCols, 2)
    currentArea = areaCols(0, i)
    colList = ""
    
    '拼接列名
    For j = 1 To UBound(areaCols, 1)
        If areaCols(j, i) <> "" Then colList = colList & "," & areaCols(j, i)
    Next j
    colList = Mid(colList, 2) '移除开头逗号
    
    '生成Insert语句（用'?'作为参数占位符，可按需替换为具体值）
    insertStmt = "INSERT INTO table_" & currentArea & " (" & colList & ") VALUES (" & _
        Replace(String(UBound(Split(colList, ",")) + 1, "x"), "x", "?") & ")"
    
    Debug.Print insertStmt '输出到立即窗口，或写入文件/执行
Next i

关键细节 #

• 数据库适配：如果是Access，查询列名的SQL改为：

  Set rsCols = conn.OpenRecordset("SELECT * FROM table_" & currentArea & " WHERE 1=0")
  '然后遍历rsCols.Fields获取列名
  

• 数组维度优化：若需要(区域索引, 列索引)的结构，可先获取所有区域的最大列数，再一次性初始化数组。
• 扩展性：后续新增区域只需在creator表添加记录，无需修改VBA代码。

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