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

我试图编写一些代码来搜索一个单词，如果在第一个第二列中找不到该单词，我将删除该行。通过VBA删除每个工作表中的特殊行

此代码贯穿每张表。

不幸的是，这个脚本需要永远和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

来源

2017-04-05 MorphhproM

开始代'行= bereich.Rows.Count'用'行= bereich.UsedRange.Rows.Count'并且仅处理_used_行而不是_all_行（即约100万）。顺便说一句：我假设'bereich'指的是一些工作表对象 – user3598756

您是否还可以为您的代码（分别为初始和最终）添加Application.Calculation = xlCalculationManual和Application.Calculation = xlCalculationAutomatic？如果工作簿中有一定的计算做，这将提高你的日常... – Pspl

的表现我不认为你需要创建的一切变量...你可以参考的单元格的值作为单元（i，j）的.value的。你可以在设置一次的时候使用它......但是当它在执行过程中定期重新分配时，则更好地引用它，而不是每次都设置一个变量 –

你能尝试一些简单的像：

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

来源

2017-04-05 08:47:05 Pspl

不幸的是，你的代码不会删除任何行 – MorphhproM

真的吗？它在我的机器上... – Pspl

你可以试试这个，我相信这应该为你工作。它还没有经过测试。

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

来源

2017-04-05 20:17:00 MTBthePRO

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

回答

相关问题