VBA调用SQL输出至Excel单元格时触发运行时错误1004求助

问题描述 #

运行VBA代码实现DemandNumber与PartNumber乘积写入单元格时，持续触发「Run-time error '1004': Application-defined or object-defined error」，报错行高亮：

Sheets("ProjectedUnits").Cells(2 + i, 1).Value = DemandNumber(i)(0)

核心原因 #

报错根源在于WNumber集合的错误使用：

• WNumber在循环外部初始化，每次数据库循环都会向该集合添加新的周数（rs.Fields(0)）
• 随后将整个WNumber集合存入DemandNumber数组的第一个元素，而非单个周数值
• Excel无法将集合对象直接写入单元格，因此触发1004错误

修复方案 #

1. 简化数据存储逻辑 #

无需用WNumber集合存储单个周数值，直接将rs.Fields(0)的数值存入数组即可，删除不必要的集合操作。

2. 优化工作表操作（可选） #

将表头赋值移到循环外部，避免重复执行，提升代码效率。

修改后的完整代码 #

Option Explicit

Private Sub CalculateBT_Click()

Dim dbConnection As Object
Dim strSQL As String
Dim strConnection As String
Dim rs As Object

Set dbConnection = CreateObject("ADODB.Connection")
strConnection = "Provider = Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Application.ActiveWorkbook.Path & "\MyMRPDatabase2.accdb"

' 拆分文本框中的周数
Dim WeekValues As Variant
WeekValues = Split(WeekNumberTB.Value, ", ")

strSQL = "SELECT WeekNumber, ProjectedUnits FROM MarketDemand " & _
         "WHERE (WeekNumber IN (" & Join(WeekValues, ", ") & ")) " & _
         "ORDER BY WeekNumber ASC;"
        
dbConnection.Open strConnection
Set rs = dbConnection.Execute(strSQL)

Dim DemandNumber As Object
Set DemandNumber = CreateObject("System.Collections.ArrayList")

Do While Not rs.EOF
    ' 直接存入周数和预计数量，无需集合
    DemandNumber.Add Array(rs.Fields(0).Value, rs.Fields(1).Value)
    rs.MoveNext
Loop
        
rs.Close
dbConnection.Close

If DemandNumber.Count = 0 Then
    MsgBox "No data found in DemandNumber array."
    Exit Sub
End If

With Worksheets("ProjectedUnits")
    .Activate
    .Range("B2:S" & .Cells(.Rows.Count, "B").End(xlUp).Row).ClearContents
    
    ' 一次性设置表头，避免循环重复赋值
    .Cells(1, 1).Value = "Week Number"
    .Cells(1, 2).Value = "PartID"
    .Cells(1, 3).Value = "Part01"
    .Cells(1, 4).Value = "Part02"
    .Cells(1, 5).Value = "Part03"
    .Cells(1, 6).Value = "Part04"
    .Cells(1, 7).Value = "Part05"
    .Cells(1, 8).Value = "Part06"
    .Cells(1, 9).Value = "Part07"
    .Cells(1, 10).Value = "Part08"
    .Cells(1, 11).Value = "Part09"
    .Cells(1, 12).Value = "Part10"
    .Cells(1, 13).Value = "Part11"
    .Cells(1, 14).Value = "Part12"
    .Cells(1, 15).Value = "Part13"
    .Cells(1, 16).Value = "Part14"
    .Cells(1, 17).Value = "Part15"
    .Cells(1, 18).Value = "Part16"
    .Cells(1, 19).Value = "Part17"
    
    Dim i As Long
    For i = 0 To DemandNumber.Count - 1
        .Cells(2 + i, 1).Value = DemandNumber(i)(0)
        .Cells(2 + i, 3).Value = DemandNumber(i)(1) * 1
        .Cells(2 + i, 4).Value = DemandNumber(i)(1) * 1
        .Cells(2 + i, 5).Value = DemandNumber(i)(1) * 1
        .Cells(2 + i, 6).Value = DemandNumber(i)(1) * 1
        .Cells(2 + i, 7).Value = DemandNumber(i)(1) * 2
        .Cells(2 + i, 8).Value = DemandNumber(i)(1) * 2
        .Cells(2 + i, 9).Value = DemandNumber(i)(1) * 2
        .Cells(2 + i, 10).Value = DemandNumber(i)(1) * 4
        .Cells(2 + i, 11).Value = DemandNumber(i)(1) * 2
        .Cells(2 + i, 12).Value = DemandNumber(i)(1) * 2
        .Cells(2 + i, 13).Value = DemandNumber(i)(1) * 2
        .Cells(2 + i, 14).Value = DemandNumber(i)(1) * 2
        .Cells(2 + i, 15).Value = DemandNumber(i)(1) * 2
        .Cells(2 + i, 16).Value = DemandNumber(i)(1) * 1
        .Cells(2 + i, 17).Value = DemandNumber(i)(1) * 1
        .Cells(2 + i, 18).Value = DemandNumber(i)(1) * 1
        .Cells(2 + i, 19).Value = DemandNumber(i)(1) * 2
    Next i
End With

End Sub

额外说明 #

• 修复后DemandNumber数组的每个元素直接存储单个周数值和对应的预计数量，避免了集合嵌套导致的类型错误
• 使用With Worksheets("ProjectedUnits")减少重复调用，提升代码执行效率
• 确保从数据库读取的字段值直接取.Value，避免存储字段对象本身

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