Question

我的代码无效。它在uni.entirerow.delete行中断，错误为1004.这表明它正在构建数组，但我必须引用错误的东西？我最初只是删除了line = by = line，但它花了太长时间，并且有大约600k行要通过。

如果列B的值等于来自p的{{1}}的任何值，则应该引用宏。如果是，请将其添加到ws2，然后在完全审核范围后删除。联盟应该比逐行删除更快。

有什么想法吗？完整代码如下：

uni

编辑：这是一个＆＃39;工作＆＃39;代码虽然不是最优的。

Option Explicit
Sub TrimOut()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long, p As Long
Dim uni As Range

Application.Calculation = xlCalculationManual


Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)

For i = 610197 To 591043 Step -1
    For p = 8 To 82
        If ws1.Range("B" & i).Value = ws2.Range("A" & p).Value Then
            'ws1.Rows(i).Delete old snippet, works fine
            If uni Is Nothing Then
                Set uni = ws1.Cells(i, 1).EntireRow
            Else
                Set uni = Application.Union(uni, ws1.Cells(i, 1).EntireRow)
            End If
        End If
    Next p
Next i

If Not uni Is Nothing Then
uni.EntireRow.Delete
End If

Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

我刚刚运行了你的代码，似乎缓慢不在删除中，而是在嵌套循环中。你迭代超过140万次（（610197-591043）*（82-8））并且每次你可能改变一个范围。这通常很慢。想想另一种方法，例如记录数组或列表中的数据，然后进一步尝试。

要了解自己，请在Stop之后的行上写下Next i，看看它到达的速度有多快。然后删除速度非常快。

Answer 2

我已成功运行以下代码。对于某些不同的报告，我需要查看p = 1 to 958的“前5名”，“前10名”等的一些指标。谢谢大家的帮助。

看来“真正的”问题是excel不想删除未分组的行组，并且会抛出绝对的组合。

在p之前移动计数循环可能是最佳的，但无论如何。

Option Explicit
Sub TrimOut()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long, p As Long
Dim uni As Range
Dim count As Long
Dim lrow As Long


Application.Calculation = xlCalculationManual


Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)

lrow = ws1.Range("A" & ws1.Rows.count).End(xlUp).Row

For i = lrow To 1 Step -1
    For p = 1 To 82
        If Not uni Is Nothing Then
            If count > i + 1 Then
                uni.Delete
                Set uni = Nothing
            End If
        End If

        If ws1.Range("B" & i).Value = ws2.Range("A" & p).Value Then
            If uni Is Nothing Then
                Set uni = ws1.Rows(i)
            Else
                Set uni = Excel.Union(uni, ws1.Rows(i))
            End If
            count = i
        End If
    Next p
Next i

If Not uni Is Nothing Then
    uni.Delete
End If

Application.Calculation = xlCalculationAutomatic
End Sub

VBA联盟不按预期工作

2 个答案: