VBA宏导致Excel冻结

时间:2018-04-23 13:16:38

标签: excel vba excel-vba

我创建了一个简单的vba宏来迭代excel中的2个标签。每个选项卡的长度始终相同。目前,每个标签大约有155,000行。我不希望标签超过200,000行。

在下面的代码中,任何x的最大数量为3,000。 (200,000 * 3,000)= 600,000,000,我相信变体可以处理。

问题在于,当我运行宏excel冻结时。我认为这不是用于处理excel的太多行,但也许这不是真的。当我减少行数时,宏按预期完成。

这段代码有更好的解决方案吗?

我在64位计算机上使用64位excel 2016.

仅供参考:我添加了ROUND函数,因为我认为所有额外的小数都可能导致冻结。

log.retention.minutes=3
log.cleanup.policy=delete

1 个答案:

答案 0 :(得分:0)

谢谢大家的帮助。匹配功能允许宏完成;虽然很慢。完成后仍需大约10-20分钟,具体取决于机器。这项目前有效,但如果找到更有效的解决方案,则会发布更新。

For i = 1 To lastrow_Sheet1 - 1
    deriv = Trim(ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 1).Value)

        deriv_row = Application.WorksheetFunction.Match(deriv, ThisWorkbook.Sheets("Sheet2").Range("C:C"), 0)

        If IsError(deriv_row) Then
            MsgBox "Could not find Derivative " & deriv & " in Sheet2 file, but it is in Sheet1 file."
            m = m + 1
            rng_lostpolicies.Offset(m, 0) = deriv
            GoTo ErrorHandler
        End If

                If Trim(ThisWorkbook.Sheets("Sheet2").Cells(deriv_row, 12)) = "x1" Then
                    x1_indexcounter = Round(x1_indexcounter + ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 2), 4)
                    x1_derivcounter = x1_derivcounter + 1
                ElseIf Trim(ThisWorkbook.Sheets("Sheet2").Cells(deriv_row, 12)) = "x2" Then
                    x2_indexcounter = Round(x2_indexcounter + ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 2), 4)
                    x2_derivcounter = x2_derivcounter + 1
                ElseIf Trim(ThisWorkbook.Sheets("Sheet2").Cells(deriv_row, 12)) = "x3" Then
                    x3_indexcounter = Round(x3_indexcounter + ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 2), 4)
                    x3_derivcounter = x3_derivcounter + 1
                ElseIf Trim(ThisWorkbook.Sheets("Sheet2").Cells(deriv_row, 12)) = "x4" Then
                    x4_indexcounter = Round(x4_indexcounter + ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 2), 4)
                    x4_derivcounter = x4_derivcounter + 1
                ElseIf Trim(ThisWorkbook.Sheets("Sheet2").Cells(deriv_row, 12)) = "x5" Then
                    x5_indexcounter = Round(x5_indexcounter + ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 2), 4)
                    x5_derivcounter = x5_derivcounter + 1
                Else
                    MsgBox "There is a new index for derivative id " & deriv
                    f = f + 1

                    If f > 10000 Then ' 10000 is an arbitrary number.
                        MsgBox "There are more than 10000 policies with a new index. Fix macro and rerun. Exiting macro."
                        Exit Sub
                    Else
                        rng_foundindicies.Offset(f, 0) = deriv
                    End If
                End If

ErrorHandler:                            
    Next i