我收到了以下错误消息：
运行时错误＆＃39; 1004＆＃39;：
应用程序定义或对象定义的错误
当我尝试将数组写入工作表时。这是相关的代码片段：
arr.ind=TRUE错误显示在最后一行。我进行了三重检查：所有这些变量都在过程的早期定义并正常工作。事实上，大约50行，我使用相同的精确代码写入不同的工作表，它工作得很好。
有趣的是，这条线似乎正在尝试工作。如果我查看wsDetails工作表，我可以看到它已经编写了前6,092行。数组中总共有大约14-15k行需要写入（有106列）。
当我只有104列时，这段代码工作正常（除了数组大小以外没有改变任何东西以容纳新的数据集）。这是内存/大小问题吗？
如果它有用，我愿意在这里发布完整的代码，但它非常大。提前感谢您的任何意见或建议！
编辑：这是整个过程以防万一。我真的没有看到任何错误：
'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
如果我从
更改最后一行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
它工作正常（吐出＆＃34;测试＆＃34;在所有14493行和106列中）。这意味着它知道lngNumRows = 14493和lngNumColumns = 106，因此数组本身已正确定义。
我在这里完全不知所措。
答案 0 :(得分：0)
所以没有查看数据集，你们就没有办法知道这一点，但事实证明，我添加的一个新列在写入wsTemp工作表时被格式化为“Date” 。但是，此单元格中包含的数据是财务信息。
所以我在代码中添加了以下内容：
split在程序将所有数据写入数组之前。现在一切正常。我猜它与负值（对于经济损失）有关，与日期格式相冲突。
希望这有助于将来遇到类似错误的其他人。感谢大家的投入 - 非常感谢！