刪除Excel中一行中多個單元格中包含單個字母的行

Question

我想知道是否僅通過公式或快捷方式就能解決此問題，或者是否需要使用VBA。 我正在使用的電子表格包含112行，31列和33行，其中包含“ Y”（對於此報表，Y =正）。 我正在嘗試刪除整個行中一直不包含單個“ Y”的行（E-AA列），因此在電子表格中僅保留行和行中某處包含“ Y”的人的名字。 我從其他人那里獲得了一段VBA代碼片段，該片段產生了一些成功的結果，但並未在每行中都包含“ Y”（我算出33行包含Y，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