Question

我有一个报告，在最后一条记录下方添加了一个重复的行，并附有重要信息。我试图将数据拉入数组并运行嵌套循环以查找重复项，复制相关行所需的唯一信息，然后标记该特定行以进行删除;然而，当数据集为~10,000行时，循环保持超时。

请参阅下面的代码：

Private Function MoveStatus2()

Dim eStatus As Variant
Dim arr() As Variant
Dim i As Long, x As Long, y As Long, lr As Long

lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

arr() = ActiveWorkbook.Sheets("FinancialReprt").Range(Cells(1, 22), Cells(lr, 25)).Value2

For i = 2 To UBound(arr())

    For x = UBound(arr()) To LBound(arr()) Step -1

        y = x

        If arr(i, 1) = arr(x, 1) And (Not i = x) And Not IsEmpty(arr(x, 4)) Then
            eStatus = arr(x, 4)

            Do Until y = i - 1

                arr(y, 4) = eStatus

            Loop

            If IsEmpty(arr(i, 2)) Then arr(x, 4) = "REMOVE"

        End If
    Next x
Next i

Worksheets.Add

ActiveSheet = Application.Transpose(arr())
End Function

Answer 1

原始代码有三个问题：

1：＆＃39; Do循环＆＃39;是无限的，因为它不会随着每次迭代而减少，以达到“循环”。号。

2：＆＃39; i循环＆＃39;应该被设置为＆＃39; x循环＆＃39;在＆＃39; do循环后的整数＆＃39;，以便在他们结束的地方拿起支票（＆＃39; x循环＆＃39;从底行开始并向上运行，同时＆＃ 39; i循环从顶行开始并向下运行

3：内部循环（＆＃39; x循环＆＃39;）应该有一个指令退出一旦检查完成后，范围包括＆＃39; x＆＃39;和＆＃39;我循环＆＃39;。

代码如下：

Private Function Update()

Dim eStatus As Variant
Dim arr() As Variant
Dim i As Long, x As Long, y As Long, lr As Long

lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

arr() = ActiveWorkbook.Sheets("FinancialReprt").UsedRange.Value2

For i = 2 To UBound(arr())
    For x = UBound(arr()) To LBound(arr()) Step -1
        y = x

        If arr(i, 22) = arr(x, 22) And (Not i = x) And Not IsEmpty(arr(x, 25)) Then

            eStatus = arr(x, 25)

            Do While y >= i

                arr(y, 25) = eStatus

                y = y - 1

            Loop

            If IsEmpty(arr(i, 23)) Then arr(x, 25) = "REMOVE"

            i = x

            Exit For

        End If
    Next x
Next i
End Function

尝试清理数据集时VBA / Excel超时

1 个答案: