在 for 循环中删除重复项会使 Excel 崩溃

Question

我有一个 for next 循环，它运行了几十万行，对大部分内容进行了更改。数组可以让这段代码运行得更快吗？

我的 for 循环示例。有时它会超载并使 Excel 崩溃。 （仅供参考，我的循环必须从下到上运行才能达到预期目的。）

Sub RemoveDuplicates()

Dim shWorkBook As Worksheet
Dim wkb As Workbook
Dim FullYearData As Worksheet
Set wkb = ThisWorkbook

With wkb
    Set shWorkBook = .Sheets("Workbook")
    Set shFullYearData = .Sheets("FullYearData")
End With

Dim i As Long
Dim LastRowW As Long

On Error Resume Next

Call TurnOffCalc

FirstRowW = shWorkBook.Cells(1, 1).Row
FirstColW = shWorkBook.Cells(1, 1).Column
LastRowW = shWorkBook.Cells(Rows.Count, 1).End(xlUp).Row
LastColW = shWorkBook.Cells(2, Columns.Count).End(xlToLeft).Column

i = LastRowW

Sum = 0
shWorkBook.Activate

For i = LastRowW To 1 Step -1
    If shWorkBook.Cells(i, 7) = shWorkBook.Cells(i - 1, 7) Then
        shWorkBook.Cells(i, 26) = vbNullString
    End If
    
    If shWorkBook.Cells(i, 26).Value <> "" Then
        shWorkBook.Cells(i, 27) = Sum + Cells(i, 25).Value
        Sum = 0
    ElseIf shWorkBook.Cells(i, 26).Value = "" Then

        Sum = shWorkBook.Cells(i, 25).Value + Sum
    End If
Next

p = FirstRowW + 1
For p = FirstRowW + 1 To LastRowW Step 1
    shWorkBook.Cells(p, 28) = Application.WeekNum(shWorkBook.Cells(p, 3))
Next

shWorkBook.Cells(1, 28).Value = "Week Number"
Call TurnOnCalc
 
End Sub

Answer 1

试试这样的：

Sub RemoveDuplicates()

    Dim shWorkBook As Worksheet
    Dim wkb As Workbook
    Dim FullYearData As Worksheet
    Dim i As Long, Sum
    Dim LastRowW As Long, LastColW As Long, tbl As Range, data
    
    
    Set wkb = ThisWorkbook
    With wkb
        Set shWorkBook = .Sheets("Workbook")
        'Set shFullYearData = .Sheets("FullYearData")
    End With
    
    LastRowW = shWorkBook.Cells(Rows.Count, 1).End(xlUp).Row
    LastColW = shWorkBook.Cells(2, Columns.Count).End(xlToLeft).Column
    
    Set tbl = shWorkBook.Range("A1").Resize(LastRowW, 28) 'include "Week number" (?)
    data = tbl.Value 'get the range value as an array
    data(1, 28) = "Week Number"

    Sum = 0
    For i = LastRowW To 1 Step -1
        
        If data(i, 7) = data(i - 1, 7) Then data(i, 26) = vbNullString
        
        If data(i, 26).Value <> "" Then
            data(i, 27) = Sum + data(i, 25).Value
            Sum = 0
        Else
            Sum = data(i, 25).Value + Sum
        End If
        
        If i > 1 Then data(i, 28) = CLng(Format(data(i, 3), "ww"))
        
    Next

    tbl.Value = data 'return the data

End Sub