繁体   English   中英

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

[英]Excel VBA - Find all cells with value and delete the entire row if it exist

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

在我正在使用的数据集中,我希望删除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

如果没有看到您拥有的代码,我们将无济于事。 但是从您的问题来看,以下内容可能会有所帮助。

如果使用循环,则需要包括如果不满足设置条件该怎么办。 参见示例:

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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM