Question

我有一些我已经调整过的代码，它检查2个工作表中单元格中的特定值，如果有匹配则删除第一个工作表中的整行。这工作正常，但我需要优化代码。我需要检查第二个工作表列E以查看单元格中是否有“是”，如果工作表2列A和工作表1列A中存在匹配，则工作表2列E中也有“是”应删除工作表1中包含A列匹配的行。这是我目前的代码，我无法计算出and位以检查E列工作表2，希望有人能够提供帮助。

当前代码

Private Sub UserForm_Terminate()

Dim uprn1 As Range
Dim uprn2 As Range, rngtodel As Range, c As Range
Dim lastrow As Long

With Worksheets("Enum 1")
    lastrow = .Cells(.Rows.Count, "a").End(xlUp).Row
    Set uprn1 = .Range("a2:a" & lastrow)
End With

Set uprn2 = Worksheets("results1").Range("a:a")
For Each c In uprn1

    If Not IsError(Application.Match(c.value, uprn2, 0)) Then
    'if value from uprn1 is found in uprn2 then remember this cell for deleting

        If rngtodel Is Nothing Then
            Set rngtodel = c
        Else
            Set rngtodel = Union(rngtodel, c)
        End If

    End If
Next c

If Not rngtodel Is Nothing Then
    rngtodel.EntireRow.Delete
End If

End Sub

这当然可能不是解决这个问题的最好办法，所以任何帮助都会得到很好的接受

Answer 1

尝试更改

If Not IsError(Application.Match(c.Value, uprn2, 0)) Then

到

If Not IsError(Application.Match(c.Value, uprn2, 0)) And Worksheets("results2").Range("E" & c.Row).Value = "YES" Then

Answer 2

尝试以下代码：

Option Explicit 

Private Sub UserForm_Terminate()

Dim uprn1 As Range
Dim uprn2 As Range, rngtodel As Range, c As Range
Dim lastrow As Long

With Worksheets("Enum 1")
    lastrow = .Cells(.Rows.Count, "a").End(xlUp).Row
    Set uprn1 = .Range("A2:A" & lastrow)
End With

Set uprn2 = Worksheets("results1").Range("A:A")
For Each c In uprn1

    If Not IsError(Application.Match(c.value, uprn2, 0)) Then
        Dim Rowmatch As Long
        Rowmatch = Application.Match(c.value, uprn2, 0)

        ' check if cell in Column E in the "Match" row found in the second worksheet value is "YES"
        If UCASE(Worksheets("results1").Range("E" & Rowmatch).value) = "YES" Then

            'if value from uprn1 is found in uprn2 then remember this cell for deleting
            If rngtodel Is Nothing Then
                Set rngtodel = c
            Else
                Set rngtodel = Union(rngtodel, c)
            End If
        End If

    End If
Next c

If Not rngtodel Is Nothing Then
    rngtodel.EntireRow.Delete
End If

End Sub

Answer 3

编辑处理数字作为过滤值和字符串

Option Explicit

Sub main()
    Dim uprn1() As String '<--| declare codes array as of "String" type

    uprn1 = GetArray '<--| use a helper function to fill the codes array and not to clutter "main" code

    With Worksheets("results1")
        With .Range("E1", .Cells(.Rows.count, "a").End(xlUp)) '<--| reference its columns A to E cells from row 1 down to last column A not empty cell
            .AutoFilter Field:=1, Criteria1:=uprn1, Operator:=xlFilterValues  '<--| filter it on its 1st column with 'uprn1' values
            If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filtered cells other than headers
                .AutoFilter Field:=5, Criteria1:="YES" '<--| filter it on its 5th column with "YES"
                If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .SpecialCells(xlCellTypeVisible).EntireRow.Delete  '<--| delete filtered cells other than headers, if any
            End If
        End With
        .AutoFilterMode = False '<--| remove AutoFilter and show all rows back
    End With
End Sub

Function GetArray() As String()
    Dim iCell As Long

    With Worksheets("Enum 1")
        With .Range("a2", .Cells(.Rows.count, "a").End(xlUp))
            ReDim arr(1 To .Rows.count) As String
            For iCell = 1 To .Rows.count
                arr(iCell) = .Cells(iCell, 1).Value
            Next iCell
        End With
    End With
    GetArray = arr
End Function

找到匹配项并满足条件时删除excel中的行

3 个答案: