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

时间:2018-04-12 21:37:52

标签: excel vba excel-vba

这是我第一次在这里提问。我已经挖过类似的问题,但在解决这个困境时却没有运气。我感谢你能给我的任何帮助。

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

我第一次成功使用.Setfilter,选择范围,并使用EntireRow.Delete。但如果没有要选择的行,这最终会删除整个数据集。

总结问:查看范围(“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

1 个答案:

答案 0 :(得分: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