Excel VBA - 查找所有具有值的单元格并删除整行（如果存在）

Posted 2023-02-18

【中文标题】Excel VBA - 查找所有具有值的单元格并删除整行（如果存在）

【英文标题】：Excel VBA - Find all cells with value and delete the entire row if it exist

【发布时间】：2018-09-23 04:19:45

【问题描述】：

这是我第一次在这里提问。我已经研究了类似的问题，但还没有解决这个难题。感谢您给我的任何帮助。

在我正在使用的数据集中，我希望删除列 R 中包含单词“Bench”的所有行。我已经运行了工作表的其余部分，并将 Lrow 值设置为最后一行。

我首先成功地使用了 .Setfilter、选择范围和使用 EntireRow.Delete。但如果没有可供选择的行，这最终会删除整个数据集。

总结一下这个问题：查看 Range("R2":"R" & Lrow)，找到包含文本“Bench”的所有单元格，然后删除该行。

谢谢！

这是现在的整个 VBA（这一点在底部附近）：

Sub BE_Time_to_Fill()
'
' BE_Time_to_Fill Macro
'

Dim StartCell As Range
Dim RangeName As String
Dim myValue As Variant


Set StartCell = Range("A1")

myValue = InputBox("Enter Date: YY-MMM")

'Select Range
  StartCell.CurrentRegion.Select
  RangeName = "Dataset"

Dim LRow As Long
Dim lCol As Long

    'Find the last non-blank cell in column A(1)
    LRow = Cells(Rows.Count, 1).End(xlUp).Row

    'Find the last non-blank cell in row 1
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column

    Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("J1").FormulaR1C1 = "Time to Fill"
    Range("J2", "J" & LRow).FormulaR1C1 = "=RC[1]+RC[2]"

    Range("F1").Select
    Range("F1").FormulaR1C1 = "Job Code"
    Range("F1", "F" & LRow).AutoFilter 1, ""
    Range("F2", "F" & LRow).FormulaR1C1 = "=RC[-1]"
    [F1].AutoFilter

    Range("M1").FormulaR1C1 = "Source Time"

    Columns("N:N").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("N1").FormulaR1C1 = "Cycle Time"
    Range("N2", "N" & LRow).FormulaR1C1 = "=IMSUB(RC[1],RC[-1])"

    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").FormulaR1C1 = "Application ID"
    Range("A2", "A" & LRow).FormulaR1C1 = "=CONCATENATE(RC[1],RC[4])"

    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").FormulaR1C1 = "Timeframe"
    Range("B2", "B" & LRow).Value = myValue


    Dim rng As Range
    Dim DelRng As Range

    Set DelRng = Range("R2:R" & LRow)

    For Each rng In DelRng
        If rng.Value = "*Bench" Then
            rng.EntireRow.Delete
        ElseIf rng.Value <> "*Bench" Then
        End If
    Next

    Range("G:H,M:N").Delete Shift:=xlToLeft 
    Range("A1").Select
End Sub

【问题讨论】：

寻求调试帮助的问题（“为什么这段代码不起作用？”）必须包括所需的行为、特定的问题或错误以及在问题本身中重现它所需的最短代码。没有明确问题陈述的问题对其他读者没有用处。请参阅：如何创建minimal reproducible example

您也可以发布您的代码吗？

If rng.Value = "*Bench" 不能用作通配符。请改用If rng.Value Like "*Bench*"

【参考方案1】：

没有看到你有什么代码，我们无法帮助更新它。但从您的问题来看，以下可能会有所帮助。

如果您使用的是循环，则需要包含不满足设置条件时要执行的操作。见例子：

Sub example()
    Dim rng As Range, DelRng As Range
    Dim LastRow As Long
    LRow = Range("R" & Rows.Count).End(xlUp).Row 'test for last filled row in column R

    Set DelRng = Range("R1:R" & LRow) 'sets your range
    For Each rng In DelRng
                                                                     'change this value to match whatever you want to find. make sure this is entered as ALL CAPS and without spaces
        If UCase(WorksheetFunction.Substitute(rng.Value, " ", "")) = "GEM/BENCH" Then
            rng.EntireRow.Delete
        ElseIf UCase(WorksheetFunction.Substitute(rng.Value, " ", "")) <> "GEM/BENCH" Then 'if loop can't find anything it will just exit
        End If
    Next
End Sub

【讨论】：

谢谢迈克！这似乎很接近，但它没有获取数据。单元格的全文是“GEM / Bench”，所以我试图通配符或找到单词 bench。不管我如何改变那件作品，它仍然会被遗漏。在问题中添加了完整的 VBA。

您可能必须将两者都评估为UCase，如果有空白，我建议使用WorksheetFunction.Substitute 给我一秒钟，我会更新我的答案

谢谢迈克。将其插入并完全按预期进行。范围内有很多空白单元格。我要去阅读你现在提供的代码。