Question

这是我的代码。问题在于，它正在超过4,000行的工作表上运行，并且需要一段时间才能完成。寻找一种更快的方法。

'Transfer rows with null Updated_SAT into SAT_errors sheet

Sheet4.Range("A1:BN1").Copy Sheet8.Range("A1")

Dim j As Integer
j = 2
For i = 2 To max_row
    If (Len(Sheet4.Range("BN" & i).Value) = 0 Or Sheet4.Range("BN" & i).Value = 0) Then
    Sheet4.Rows(i).Copy Sheet8.Range("A" & j)
    j = j + 1
    End If
Next i
Dim k As Integer
k = 2
For i = 2 To max_row
    If (IsEmpty(Sheet4.Range("BN" & i).Value) Or Sheet4.Range("BN" & i).Value = 0) Then
    Sheet4.Range("A" & i & ":" & "BN" & i).Delete
    i = i - 1
    End If
    k = k + 1
    If k = max_row Then
    Exit For
    End If

Next i

Answer 1

我认为这就是您要寻找的。代码运行缓慢的原因是，您试图在循环内复制，粘贴和删除，这意味着每个循环会导致3个操作实例。该方法在循环之外执行动作，这意味着您只有3个动作实例。

更好的方法是简单地用空格过滤您的列，然后复制/粘贴/删除过滤器显示的单元格。但是您采用了循环方法，因此这是通过循环完成询问的更好方法。

Option Explicit

Sub Blanks()

Dim ws4 As Worksheet: Set ws4 = ThisWorkbook.Sheets("Sheet4")
Dim ws8 As Worksheet: Set ws8 = ThisWorkbook.Sheets("Sheet8")

Dim LRow As Long, MyCell As Range, MyRange As Range, MyUnion As Range

LRow = ws4.Range("BN" & ws4.Rows.Count).End(xlUp).Row
Set MyRange = ws4.Range("BN2:BN" & LRow)

For Each MyCell In MyRange
    If MyCell = "" Then
        If Not MyUnion Is Nothing Then
            Set MyUnion = Union(MyUnion, MyCell)
        Else
            Set MyUnion = MyCell
        End If
    End If
Next MyCell

If Not MyUnion Is Nothing Then
    MyUnion.EntireRow.Copy
    ws8.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    MyUnion.EntireRow.Delete
End If

End Sub

将具有空值的行转移到其他工作表

1 个答案: