arrays - Excel 2013 VBA : Writing Array to Sheet "Application-Defined or Object-Defined Error"

标签 arrays vba excel

我收到以下错误消息:

Run-time error '1004':

Application-defined or object-defined error

当我尝试将数组写入工作表时。这是相关的代码片段:

'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

错误显示在最后一行。我已经进行了三次检查:所有这些变量都已在该过程的早期定义并正常工作。事实上，大约 50 行我使用相同的代码写入不同的工作表，它工作得很好。

有趣的是，这条线似乎实际上正在尝试工作。如果我查看 wsDetails 工作表，我可以看到它已写入前 6,092 行。数组中总共有约 14-15k 行需要写入(有 106 列)。

当我只有 104 列时，这段代码工作得很好(除了数组大小以容纳新数据集之外，没有更改任何内容)。这是内存/大小问题吗？

如果有帮助的话，我愿意在这里发布完整的代码，但它相当庞大。预先感谢您的任何意见或建议!

编辑:这是整个过程，以防有帮助。我真的没有发现任何问题:

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 列中吐出“Test”)。这意味着它知道 lngNumRows = 14493 和 lngNumColumns = 106，因此数组本身已正确定义。

我在这里完全不知所措。

最佳答案

因此，如果不查看数据集，你们就无法知道这一点，但事实证明，我添加的新列之一在写入 wsTemp 工作表时被格式化为“日期” 。然而，该单元格中包含的数据是财务信息。

所以我在代码中添加了以下内容:

wsTemp.Columns("DB:DB").NumberFormat = "General"

就在该过程将所有数据写入数组之前。现在一切都很好。我猜这与负值(经济损失)与日期格式冲突有关。

希望这可以帮助将来遇到类似错误的其他人。感谢大家的意见 - 非常感谢!

关于arrays - Excel 2013 VBA : Writing Array to Sheet "Application-Defined or Object-Defined Error"，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/34930121/

上一篇：r - 如何将日期和时间转换为数值

下一篇：vba - 范围已变成表格，宏将无法运行

相关文章：

sql - 使用 Access VBA，如何计算选择查询中的输出记录数并将计数存储为 VBA 变量？

vba - Excel VBA - 以编程方式更改图表的来源？

excel - 我可以限制用户从不受支持的 Excel 版本保存文件吗？

java - 如何将方法设置为数组？

javascript - Javascript 中的经典字数统计算法

excel - 从命令行使用 VBScript 从 Excel 外部运行 Excel 宏

excel - 在时间表内同时刷新外部数据源和数据透视表

java - 尝试创建汽车对象数组，结果为 null

java扫描仪获取数据并检测输入的每个数字和字符

excel - VBA 组合框值编译问题

©2024 IT工具网  联系我们