Question

以下代码使用范围来删除工作表中的行，我的worbook没有规范化，所以我的问题是如何在这里使用InStr函数来删除类似的值，即“Apple Ltd”是否在范围内那么它会删除包含“apple”的行，反之亦然......是否可能？

更新：第28行：需要对象@freeman我无法使用“Dim Cel as Range”工作，我已经插入到此处并且在工作表的顶部插入了相同的结果。语法是你写的'Cel'吗？原文如下

 Sub Loop_Example()
    Dim ChkRange As Range
        Dim Firstrow As Long
        Dim Lastrow As Long
        Dim Lrow As Long
        Dim CalcMode As Long
        Dim ViewMode As Long
    Set ChkRange = Sheets("Sheet2").Range("A1:A13")
        With Application
            CalcMode = .Calculation
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
        End With
        With Sheet1
            .Select
            ViewMode = ActiveWindow.View
            ActiveWindow.View = xlNormalView
            .DisplayPageBreaks = False
            Firstrow = 2
            Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            For Lrow = Lastrow To Firstrow Step -1
                With .Cells(Lrow, "A")
                    If Not IsError(.Value) Then
  If Not IsError(Application.Match(.Value, ChkRange, 0)) Then
    .EntireRow.Delete
  End If
  For Each Cell In ChkRange
        If InStr(1, Cell.Value, .Value) > 0 And Cell.Value <> .Value Then
        'include the 2nd part of the "AND" to ensure you don't delete based
        'on a COMPLETE match, only on a partial match as noted in the comments
        Cell.EntireRow.Delete
    End If
  Next
End If

End With
    Next Lrow
        End With
ActiveWindow.View = ViewMode
With Application
            .ScreenUpdating = True
            .Calculation = CalcMode
        End With
    End Sub

Sub Loop_Example()
        Dim ChkRange As Range
            Dim Firstrow As Long
            Dim Lastrow As Long
            Dim Lrow As Long
            Dim CalcMode As Long
            Dim ViewMode As Long
        Set ChkRange = Sheets("Sheet2").Range("A1:A13")
            With Application
                CalcMode = .Calculation
                .Calculation = xlCalculationManual
                .ScreenUpdating = False
            End With
            With Sheet1
                .Select
                ViewMode = ActiveWindow.View
                ActiveWindow.View = xlNormalView
                .DisplayPageBreaks = False
                Firstrow = 2
                Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
                For Lrow = Lastrow To Firstrow Step -1
                    With .Cells(Lrow, "A")
                        If Not IsError(.Value) Then
      If Not IsError(Application.Match(.Value, ChkRange, 0)) Then
        .EntireRow.Delete
      End If
      For Each Cell In ChkRange
        Dim Cel As Range
            If InStr(1, Cell.Value, .Value) > 0 And Cell.Value <> .Value Then
            'include the 2nd part of the "AND" to ensure you don't delete based
            'on a COMPLETE match, only on a partial match as noted in the comments
            Cell.EntireRow.Delete
        End If
      Next
    End If

    End With
        Next Lrow
            End With
    ActiveWindow.View = ViewMode
    With Application
                .ScreenUpdating = True
                .Calculation = CalcMode
            End With
        End Sub

Answer 1

如何使用InStr()删除整行？修改代码的这一部分

If Not IsError(.Value) Then
  If Not IsError(Application.Match(.Value, ChkRange, 0)) Then
    .EntireRow.Delete
  End If
End If

这样的事情：

Dim cel as range  'put this at the top of your code with your other Dim stmts
If Not IsError(.Value) Then
  If Not IsError(Application.Match(.Value, ChkRange, 0)) Then
    .EntireRow.Delete
  End If
'note this changed row. Note carefully the SPELLING
  for each Cel in ChkRange.Cells
    if Instr(1, Cel.value, .Value) > 0 and ce.lValue <> .Value then
      'include the 2nd part of the "AND" to ensure you don't delete based
       'on a COMPLETE match, only on a partial match as noted in the comments
      cel.EntireRow.Delete
    end if
  next
End If

这可能会非常慢，因为您必须遍历ChkRange中的每个单元格，以查看Sheet1.Cells(Lrow,"I").Value是否位于其中某处。

注意：这是我的头脑和未经测试，但应该工作，或至少让你接近

使用InStr函数仅删除范围中的值

1 个答案: