Excel 2013 VBA：将数组写入表“应用程序定义的或对象定义的错误”
我收到以下错误消息：
运行时错误“1004”：
应用程序定义或对象定义的错误
当我试图写一个数组到工作表。 以下是相关的代码片段：
'Write data from arrUniverseData into wsDetails worksheet lngNumRows = UBound(arrUniverseData, 1) - LBound(arrUniverseData, 1) + 1 lngNumColumns = UBound(arrUniverseData, 2) - LBound(arrUniverseData, 2) + 1 Set rngDestination = wsDetails.Range("A" & lngFirstDetailsRow).Resize(lngNumRows, lngNumColumns) rngDestination = arrUniverseData 错误显示在最后一行。 我进行了三重检查：所有这些variables都是在程序中定义和正常工作的。 实际上，大约有50行代码使用这个相同的代码来写入不同的工作表，它工作得很好。
有趣的是，似乎这条线实际上是在尝试工作。 如果我查看wsDetails工作表，我可以看到它写了第6092行。 数组中需要写入总共〜14-15k行（有106列）。
这段代码工作得很好，当我只有104列（没有改变任何东西，除了数组大小，以适应新的数据集）。 这是一个内存/大小的问题？
如果有帮助的话，我会愿意在这里发布整个代码，但是这是相当重要的。 在此先感谢您的任何意见或build议！
编辑：这是整个过程，以防止它的帮助。 我真的在这里看不到任何错误：
Option Explicit Sub CostReductionRollup() 'Display a message box verifying that the user has already saved a backup If MsgBox("This rollup procedure will replace any existing data in all of the worksheets of this workbook--please make sure you have saved this file as a copy to prevent overwriting previous rollups.", vbOKCancel, "Warning--Save a Backup") = vbCancel Then Exit Sub End If 'Update Status Bar Call UpdateStatusBar(0, 10, 0, "Processing Universe data...") 'Disable screen updating to reduce processing time Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False 'Set public workbook, worksheet, directory, and date variables Set wbRollup = ActiveWorkbook Set wbMacro = ThisWorkbook Set wsProcess = wbRollup.Worksheets("Process") Set wsDetails = wbRollup.Worksheets("Details") strUniverseServerPath = wsProcess.Range("B7").Text & wsProcess.Range("B10").Text Set wbUniverse = Workbooks.Open(strUniverseServerPath) Set wsUniverse = wbUniverse.Worksheets("LOS Report") datRollupDate = Date 'Copy last month's subtotals into the "previous rollup" cells for easy comparison wsDetails.Range("N1").Value = wsDetails.Range("N2").Value wsDetails.Range("O1").Value = wsDetails.Range("O2").Value wsDetails.Range("P1").Value = wsDetails.Range("P2").Value wsDetails.Range("Q1").Value = wsDetails.Range("Q2").Value wsDetails.Range("R1").Value = wsDetails.Range("R2").Value 'Store data from Universe Report into arrUniverseData Dim lngFirstUniverseRow As Long Dim lngLastUniverseRow As Long lngFirstUniverseRow = 1 'Stores header row lngLastUniverseRow = wsUniverse.UsedRange.Rows.Count arrUniverseData = wsUniverse.Range("A" & lngFirstUniverseRow & ":CR" & lngLastUniverseRow) 'Close wbUniverse without saving changes wbUniverse.Close SaveChanges:=False 'Update Status Bar Call UpdateStatusBar(0, 10, 1, "Arranging Universe data...") 'Create wsTemp to temporarily store data while it is manipulated wbRollup.Worksheets.Add().Name = "Temp" Set wsTemp = wbRollup.Worksheets("Temp") 'Write data from arrUniverseData to wsTemp Dim lngNumRows As Long Dim lngNumColumns As Long lngNumRows = UBound(arrUniverseData, 1) - LBound(arrUniverseData, 1) + 1 lngNumColumns = UBound(arrUniverseData, 2) - LBound(arrUniverseData, 2) + 1 Set rngDestination = wsTemp.Range("A1").Resize(lngNumRows, lngNumColumns) rngDestination = arrUniverseData 'Insert column in wsTemp for YE Type wsTemp.Range("Y1").EntireColumn.Insert wsTemp.Range("Y1").Value = "YE_TYPE" 'Insert column in wsTemp for At Risk wsTemp.Range("Z1").EntireColumn.Insert wsTemp.Range("Z1").Value = "AT_RISK" 'Insert column in wsTemp for DC EM wsTemp.Range("O1").EntireColumn.Insert wsTemp.Range("O1").Value = "DC_EM" 'Insert column in wsTemp for Implementation Month-Year wsTemp.Range("CU1").EntireColumn.Insert wsTemp.Range("CU1").Value = "IMPLEMENTATION_MONTH_YEAR" 'Insert column in wsTemp for Carryover Implementation Month wsTemp.Range("CU1").EntireColumn.Insert wsTemp.Range("CU1").Value = "CARRYOVER_IMPLEMENTATION_MONTH" 'Insert column in wsTemp for Carryover Months wsTemp.Range("CU1").EntireColumn.Insert wsTemp.Range("CU1").Value = "CARRYOVER_MONTHS" 'Insert column in wsTemp for Current Year Net Fiscal Impact (Factored) wsTemp.Range("CU1").EntireColumn.Insert wsTemp.Range("CU1").Value = "CURRENT_YEAR_NET_FISCAL_IMPACT_(FACTORED)" 'Insert column in wsTemp for Adjusted (Floating) Impact wsTemp.Range("CU1").EntireColumn.Insert wsTemp.Range("CU1").Value = "ADJUSTED_(FLOATING)_IMPACT" 'Insert column in wsTemp for Concatenate wsTemp.Range("DA1").EntireColumn.Insert wsTemp.Range("DA1").Value = "CONCATENATE" 'Insert column in wsTemp for YTD CICT Expected Savings wsTemp.Range("DB1").EntireColumn.Insert wsTemp.Range("DB1").Value = "YTD_CICT_EXPECTED_SAVINGS" 'Update Status Bar Call UpdateStatusBar(0, 10, 2, "Writing Universe data to temporary data source...") 'Store new data from wsTemp into arrUniverseData lngFirstUniverseRow = 1 lngLastUniverseRow = wsTemp.UsedRange.Rows.Count arrUniverseData = wsTemp.Range("A" & lngFirstUniverseRow & ":DB" & lngLastUniverseRow) lngNumRows = UBound(arrUniverseData, 1) - LBound(arrUniverseData, 1) + 1 lngNumColumns = UBound(arrUniverseData, 2) - LBound(arrUniverseData, 2) + 1 'Update Status Bar Call UpdateStatusBar(0, 10, 3, "Calculating...") '----------MAIN LOOP----------MAIN LOOP----------MAIN LOOP----------MAIN LOOP----------MAIN LOOP----------MAIN LOOP----------MAIN LOOP---------- 'Loop through arrUniverseData and determine YE Type and whether project is At Risk Dim i As Long 'looper variable Dim datImpactDate As Date 'Date to hold line item's impact date Dim strCICTStatus As String 'String to hold line item's CICT status Dim strDCEM() As String 'String array to hold design control engineering managers For i = 2 To lngNumRows 'do not change first row datImpactDate = arrUniverseData(i, 25) strCICTStatus = arrUniverseData(i, 24) 'Set YE Type If strCICTStatus = "In Queue" Or strCICTStatus = "In Process : Pending Approval" Or strCICTStatus = "In Process : Business Case Started" Then arrUniverseData(i, 26) = "Potential" ElseIf strCICTStatus = "In Process : Execution Started" Then arrUniverseData(i, 26) = "Active" ElseIf strCICTStatus = "Complete" And Year(datRollupDate) - Year(datImpactDate) = 1 Then arrUniverseData(i, 26) = "Carryover" ElseIf strCICTStatus = "Complete" And Year(datRollupDate) = Year(datImpactDate) And datImpactDate < datRollupDate Then arrUniverseData(i, 26) = "In Production" ElseIf strCICTStatus = "Complete" And Year(datRollupDate) = Year(datImpactDate) And datImpactDate >= datRollupDate Then arrUniverseData(i, 26) = "Engineering Complete" ElseIf strCICTStatus = "Complete" And Year(datRollupDate) < Year(datImpactDate) Then arrUniverseData(i, 26) = "Engineering Complete" End If 'Set At Risk If arrUniverseData(i, 26) = "Carryover" Then arrUniverseData(i, 27) = "n" ElseIf arrUniverseData(i, 26) = "Potential" Then If DateDiff("d", datRollupDate, datImpactDate) <= 180 Then arrUniverseData(i, 27) = "y" Else arrUniverseData(i, 27) = "n" End If ElseIf arrUniverseData(i, 26) = "Active" Then If DateDiff("d", datRollupDate, datImpactDate) <= 60 Then arrUniverseData(i, 27) = "y" Else arrUniverseData(i, 27) = "n" End If ElseIf arrUniverseData(i, 26) = "Engineering Complete" Then If DateDiff("d", datRollupDate, datImpactDate) <= 31 Then arrUniverseData(i, 27) = "y" Else arrUniverseData(i, 27) = "n" End If Else arrUniverseData(i, 27) = "n" End If 'Set DC EM If arrUniverseData(i, 98) <> "" Then strDCEM() = Split(arrUniverseData(i, 98), "/") arrUniverseData(i, 15) = strDCEM(0) ElseIf arrUniverseData(i, 97) <> "" Then arrUniverseData(i, 15) = arrUniverseData(i, 97) ElseIf arrUniverseData(i, 95) <> "" Then arrUniverseData(i, 15) = arrUniverseData(i, 95) ElseIf arrUniverseData(i, 93) <> "" Then arrUniverseData(i, 15) = arrUniverseData(i, 93) ElseIf arrUniverseData(i, 91) <> "" Then arrUniverseData(i, 15) = arrUniverseData(i, 91) ElseIf arrUniverseData(i, 89) <> "" Then arrUniverseData(i, 15) = arrUniverseData(i, 89) End If 'Calculate Current Year Net Fiscal Impact (Factored) If arrUniverseData(i, 26) = "Potential" Then arrUniverseData(i, 100) = 0.25 * arrUniverseData(i, 59) ElseIf arrUniverseData(i, 26) = "Active" Then arrUniverseData(i, 100) = 0.75 * arrUniverseData(i, 59) Else arrUniverseData(i, 100) = arrUniverseData(i, 59) End If 'Calculate Carryover Months If arrUniverseData(i, 26) = "Carryover" Then arrUniverseData(i, 101) = arrUniverseData(i, 82) - 1 Else arrUniverseData(i, 101) = 0 End If 'Calculate Carryover Implementation Month If arrUniverseData(i, 101) = 1 Then arrUniverseData(i, 102) = "Feb" ElseIf arrUniverseData(i, 101) = 2 Then arrUniverseData(i, 102) = "Mar" ElseIf arrUniverseData(i, 101) = 3 Then arrUniverseData(i, 102) = "Apr" ElseIf arrUniverseData(i, 101) = 4 Then arrUniverseData(i, 102) = "May" ElseIf arrUniverseData(i, 101) = 5 Then arrUniverseData(i, 102) = "Jun" ElseIf arrUniverseData(i, 101) = 6 Then arrUniverseData(i, 102) = "Jul" ElseIf arrUniverseData(i, 101) = 7 Then arrUniverseData(i, 102) = "Aug" ElseIf arrUniverseData(i, 101) = 8 Then arrUniverseData(i, 102) = "Sep" ElseIf arrUniverseData(i, 101) = 9 Then arrUniverseData(i, 102) = "Oct" ElseIf arrUniverseData(i, 101) = 10 Then arrUniverseData(i, 102) = "Nov" ElseIf arrUniverseData(i, 101) = 11 Then arrUniverseData(i, 102) = "Dec" End If 'Calculate Implementation Year-Month arrUniverseData(i, 103) = arrUniverseData(i, 83) & "-" & arrUniverseData(i, 82) 'Set current fiscal columns of In Queue projects to $0 If strCICTStatus = "In Queue" Then arrUniverseData(i, 57) = 0 arrUniverseData(i, 58) = 0 arrUniverseData(i, 59) = 0 arrUniverseData(i, 99) = 0 End If 'Calculate Adjusted (Floating) Impact arrUniverseData(i, 99) = -((arrUniverseData(i, 44) * arrUniverseData(i, 46)) / 365) * DateDiff("d", datImpactDate, "12/31/" & Year(datImpactDate)) 'Calculate Concatenate If Len(arrUniverseData(i, 40)) < 4 Then arrUniverseData(i, 105) = "LS" & arrUniverseData(i, 40) & arrUniverseData(i, 28) Else arrUniverseData(i, 105) = "" & arrUniverseData(i, 40) & arrUniverseData(i, 28) End If 'Calculate YTD CICT Expected Savings If Year(datImpactDate) = Year(Date) And arrUniverseData(i, 26) = "In Production" Then arrUniverseData(i, 106) = (arrUniverseData(i, 59) / DateDiff("d", datImpactDate, "12/31/" & Year(Date))) * (DateDiff("d", datImpactDate, Date)) Else arrUniverseData(i, 106) = 0 End If Next i 'Update Status Bar Call UpdateStatusBar(0, 10, 5, "Writing calculations to temporary data source...") 'Write data from arrUniverseData to wsTemp lngNumRows = UBound(arrUniverseData, 1) - LBound(arrUniverseData, 1) + 1 lngNumColumns = UBound(arrUniverseData, 2) - LBound(arrUniverseData, 2) + 1 Set rngDestination = wsTemp.Range("A1").Resize(lngNumRows, lngNumColumns) rngDestination = arrUniverseData 'Rearrange Columns Call Rearrange_wsTemp_Columns 'Insert Dummy rows (12 dummy rows for current year, 12 dummy rows for previous year) Call InsertDummyRows 'Store new data from wsTemp into arrUniverseData lngFirstUniverseRow = 2 'Do not take header row lngLastUniverseRow = wsTemp.UsedRange.Rows.Count arrUniverseData = wsTemp.Range("A" & lngFirstUniverseRow & ":DB" & lngLastUniverseRow) 'Update Status Bar Call UpdateStatusBar(0, 10, 6, "Writing data to Details worksheet...") 'Clear data from wsDetails lngFirstDetailsRow = 5 'leaves room for the wsDetails headers lngLastDetailsRow = wsDetails.UsedRange.Rows.Count + 5 wsDetails.Rows(lngFirstDetailsRow & ":" & lngLastDetailsRow).ClearContents wsDetails.Rows(lngFirstDetailsRow & ":" & lngLastDetailsRow).Delete 'Write data from arrUniverseData into wsDetails worksheet lngNumRows = UBound(arrUniverseData, 1) - LBound(arrUniverseData, 1) + 1 lngNumColumns = UBound(arrUniverseData, 2) - LBound(arrUniverseData, 2) + 1 Set rngDestination = wsDetails.Range("A" & lngFirstDetailsRow).Resize(lngNumRows, lngNumColumns) rngDestination = arrUniverseData End Sub
如果我改变最后一行
rngDestination = arrUniverseData
至
rngDestination = "Test"
它工作得很好（在所有14493行和106列中吐出“testing”）。 这意味着它知道lngNumRows = 14493和lngNumColumns = 106，所以数组本身是正确定义的。
我在这里完全不知所措。
所以，如果不查看数据集，就没有办法知道这一点，但事实certificate，我添加的新列之一被写入wsTemp工作表时被格式化为“Date”。 但是，这个单元格中的数据是财务信息。
所以我在代码中添加了以下内容：
wsTemp.Columns("DB:DB").NumberFormat = "General"
过程在将所有数据写入数组之前。 现在一切正常。 我猜测这与负面价值（与财务损失）有冲突的date格式有关。
希望这可以帮助未来的其他人经历类似的错误。 谢谢大家的意见 – 非常感谢！