Question

我尝试编写一些代码来搜索单词，如果在第一列第二列中找不到这个单词，我会删除该行。

此代码贯穿每张工作表。

不幸的是，这个脚本就像永远一样，Excel停止工作。它适用于一张纸，但即使只有2行，也需要10秒钟。

也许你可以帮助我研究性能，因为我从来没有学过VBA，而且这段代码是我能写的最好的。

Option Explicit

Sub dontDeleteRowWithInput()
Dim wksSheet As Worksheet
Dim area As Range, i As Integer, j As Integer
Dim rows As Long
Dim Var As String
Dim bool As Boolean
Dim celltxt As String

Var = InputBox("Input", "Input")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Loop over every Worksheet in this Workbook
For Each wksSheet In ActiveWorkbook.Worksheets
    Set area = wksSheet.UsedRange
    rows = area.Rows.Count
    'Loop the rows backwards until it reaches row 2 (Row 1 should be ignored)
    For j = rows To 2 Step -1
        'Search vor the input in Column 1 and 2
        For i = 1 To 2 Step 1
            'Get the content of the reached cell in string format
            celltxt = Cells(j, i).Value
            'Compare the saved string with the input
            If InStr(celltxt, Var) > 0 Then
                'If the input is found in this cell don't delete the row
                bool = False
                Exit For
            End If
            'Delete the row if the input wasn't found in its columns
            If bool = True Then
                Rows(j).Delete
            End If
            'Reset the bool
            bool = True
        Next i
    Next j
Next wksSheet

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Answer 1

你可以尝试一些更简单的东西：

Dim wksSheet As Worksheet, i As Integer, j As Integer
Dim lastrow As Long
Dim Var As String
Var = InputBox("Input", "Input")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Loop over every Worksheet in this Workbook
For Each wksSheet In ThisWorkbook.Worksheets
    With wksSheet
        lastrow = 0
        On Error Resume Next
        lastrow = .Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
        If lastrow > 0 And Var <> "" Then
            For i = lastrow To 2 Step -1
                If InStr(.Cells(i, 1).Text, Var) > 0 Or InStr(.Cells(i, 2).Text, Var) > 0 Then
                    .rows(i).Delete
                End If
            Next i
        End If
    End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Answer 2

你可以试试这个，我相信这对你有用。它尚未经过测试。

Sub dontDeleteRowWithInput()
         Dim sht As Worksheet
         Dim nlast As Long
         For Each sht In Sheets


                nlast = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
                For n = nlast To 1 Step -1
                    If sht.Cells(n, 1).Value <> "Input" And sht.Cells(n, 2).Value <> "Input" Then
                    sht.Rows(n).EntireRow.Delete
                    End If
                    Next n

              Next sht
     End Sub

`

通过VBA删除每个工作表中的特殊行

2 个答案: