删除excel中包含行中多个单元格中单个字母的行

Question

我想知道是否通过公式或快捷方式解决了这个问题，或者我是否需要使用VBA。我正在使用的电子表格包含112行，31列和33行，其中包含“Y”（为了报告的目的，Y =正数）。我试图删除行中不包含单个“Y”的行（E-AA列），因此只有行中某处包含“Y”的人的行和名称留在电子表格中。我从其他人那里找到了一段VBA代码，这些代码产生了一些成功的结果，但没有包含每行都有一个“Y”（我计算了包含Y的33行，VBA代码只显示了14行）。

我正在使用的代码：

Sub sbDelete_Rows_IF_Cell_Contains_String_Text_Value()
    Dim lRow As Long
    Dim iCntr As Long
    lRow = 112
    For iCntr = lRow To 1 Step -1
        If Cells(iCntr, 5).Value = "N" Then
            Rows(iCntr).Delete
        End If
    Next
    End Sub

上面的代码产生了这些结果：

在其单元中包含“Y”或“N”的感兴趣的列是E到AA列。如果我不够清楚或需要进一步细节，请告诉我。

Answer 1

这可以完成手头的工作，即使我确信它可以进一步优化：

Sub foo()
    Dim lRow As Long
    Dim iCntr As Long
    lRow = 112
    For iCntr = lRow To 1 Step -1
        For i = 5 To 27 Step 2
        If Cells(iCntr, i).Value = "N" Then
            Value = Value & " Delete"
        Else
            Value = Value & " Keep"
        End If
        Next i

        If Not InStr(Value, "Keep") > 0 Then
            Rows(iCntr).Delete
        End If
        Value = ""
    Next iCntr
End Sub

Answer 2

要使用公式，过滤和复制/粘贴来做到这一点：

将此公式添加到每一行：=COUNTIF($E2:$AA2,"Y") 这将计算包含单个Y的单元格。

在数据中添加过滤器并过滤以在公式上排除0。

将过滤的数据集复制并粘贴到新工作表中。然后，您可以清除原始数据并重新粘贴它。如果你只做一次这个就很有用。

编辑：

要在VBA中执行上述过程（但是在适当的位置执行删除而不是移动到第二个工作表）：

Public Sub Test()

    Dim rDataRange As Range

    'Define range to look at.  NB:  This is a basic set-up.
    'Real scenario would allow user to make selection, or find the limits of the dataset with a FindLastCell function.
    Set rDataRange = ThisWorkbook.Worksheets("Sheet1").Range("E1:AA112")

    'This block will remove any autofilters that already exist, and then put a formula to the right of the dataset
    'to count the Y.
    With rDataRange
        .Parent.AutoFilterMode = False
        .Offset(1, .Columns.Count).Resize(.Rows.Count - 1, 1).FormulaR1C1 = "=COUNTIF(RC5:RC27,""Y"")"
    End With

    With rDataRange
        'This block filters the dataset to only show 0 in the formula.
        'The dataset is resized to include the formula.
        With .Resize(, .Columns.Count + 1)
            .AutoFilter Field:=rDataRange.Columns.Count + 1, Criteria1:="0"
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible).EntireRow.Delete 'Resized again to exclude the header.
        End With

        'The formula and filter are removed.
        .Offset(1, .Columns.Count).Resize(.Rows.Count - 1, 1).ClearContents
        .Parent.AutoFilterMode = False
    End With

End Sub