Question

我正在运行代码，以便在读取数据集中的特定字符时删除行。我运行的代码此刻只删除了一个字符，我如何调整它可以删除该列中不同调用的多个字符。 A列下的示例您在单元格A1中有Bob，在A23中有Sally。

要添加，有时Bob跟随Bob21234或Bob12434，所以数字会有所不同，我如何调整代码删除所有Bob后跟一个数字？

Sub DeleteRows()
    Dim c As Range
    Dim SrchRng

    Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
    Do
        Set c = SrchRng.Find("Bob", LookIn:=xlValues)
        If Not c Is Nothing Then c.EntireRow.Delete
    Loop While Not c Is Nothing
End Sub

Answer 1

您有两种选择。你可以尝试两者，我不确定哪一个更快。第一个允许您更改它以添加可能使其更好的异常。

这个将逐行手动检查if声明中包含的术语。

Sub Option1()

    Dim i As Integer
    Dim current As String

    For i = 65536 To 1 Step -1
        current = LCase$(ActiveSheet.Range("A" & i).Value2)

        If InStr(current, "bob") > 0 Then ActiveSheet.Rows(i).EntireRow.Delete
        If InStr(current, "sue") > 0 And InStr(current, "sally") = 0 Then ActiveSheet.Rows(i).EntireRow.Delete
    Next i

End Sub

这个方法使用内置的Range.Find()方法，因此它可能比常规循环更好地优化。但是，您必须为要查找的每个术语再次调用它。

Sub Option2()

    Call DeleteRows(ActiveSheet.Range("A1:A65536"), "Bob", "")
    Call DeleteRows(ActiveSheet.Range("A1:A65536"), "Sue", "Sally")

End Sub

Sub DeleteRows(ByVal rng As Range, ByVal term As String, ByVal exception As String)

    Dim c As Range
    Do
        Set c = rng.Find(What:=term, After:=Range("A1"), LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious)
        If Not c Is Nothing Then
            If InStr(LCase$(c.Value2), LCase$(exception)) = 0 Then c.EntireRow.Delete
        End If
    Loop While Not c Is Nothing

End Sub

Answer 2

对于使用Like比较的循环方法（而不是Like，你可以使用InStr）。

Sub DeleteRows()
    Dim SrchRng as Long
    Dim i As Long
    Set SrchRng = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For i = SrchRng to 1 Step -1
        If ActiveSheet.Cells(i, 1).Value Like "Bob*" Or ActiveSheet.Cells(i, 1).Value Like "Mark*" Then Cells(i, 1).EntireRow.Delete
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Answer 3

以下是我的观点：

Sub MultiFind()

Dim SHT As Worksheet
Dim Search_RNG As Range, Found_RNG As Range, Rows_RNG As Range
Dim MULTIVALUES As Variant
Dim Z As Long, X As Long, Y As Long

Set SHT = ActiveSheet
Set Search_RNG = SHT.Columns(1)

MULTIVALUES = Array("Bob", "Sally")

With Search_RNG
    For Z = LBound(MULTIVALUES) To UBound(MULTIVALUES)
        Set Found_RNG = .Cells(.Cells.Count)
        For X = 1 To WorksheetFunction.CountIf(Search_RNG, MULTIVALUES(Z))
            Set Found_RNG = .Cells.Find(What:=MULTIVALUES(Z), LookIn:=xlValues, LookAt:=xlPart, After:=Found_RNG, MatchCase:=False)
            If Not Found_RNG Is Nothing Then
                If Rows_RNG Is Nothing Then
                    Set Rows_RNG = SHT.Rows(Found_RNG.Row)
                Else
                    Set Rows_RNG = Union(Rows_RNG, SHT.Rows(Found_RNG.Row))
                End If
            End If
        Next X
    Next
End With

If Not Rows_RNG Is Nothing Then Rows_RNG.Delete

End Sub

Answer 4

你需要VBA吗？或者您想要一个Excel Formula解决方案？

只需添加一个公式为=COUNTIF(A:A,A1&"*")的列，然后过滤列表并删除任何>1的值。

但请回答这个问题：如果你有“Rob”和“Robert”的名字怎么办？

删除带有数字的名字可能更容易，如果是这样，那么这就是你所需要的：

Sub DeleteValuesWithNumbers(Target As Range)
Dim Cell As Range, DeleteRange As Range
    For Each Cell In Target
        If Cell Like "*[0-9]*" Then Set DeleteRange = MakeUnion(DeleteRange, Cell)
    Next
    If Not DeleteRange Is Nothing Then DeleteRange.EntireRow.Delete
End Sub

使Range Union（）更清洁的额外功能：

Public Function MakeUnion(Arg1 As Range, Arg2 As Range) As Range
    If Arg1 Is Nothing Then
        Set MakeUnion = Arg2
    ElseIf Arg2 Is Nothing Then
        Set MakeUnion = Arg1
    Else
        Set MakeUnion = Union(Arg1, Arg2)
    End If
End Function

根据字符删除excel中的行

4 个答案: