根据单元格值和列标题删除特定行

时间:2017-03-17 07:21:52

标签: vba excel-vba excel

下面是我编写的代码,它删除了"PRODUCTION"列中包含值M的行

Sub DeleteProducts()

    Dim LR, i As Long
    Dim RNG As Range
    Dim ws As Worksheet

    For Each ws In ActiveWorkbook.Sheets
        LR = ws.Cells(Rows.Count, "M").End(xlUp).Row

        For i = LR To 2 Step -1
            Select
                Case ws.Cells(i, "M").Value
                Case Is <> "Production"
                ws.Cells(i, "M").EntireRow.Delete shift:=xlUp
            End Select
        Next i
    Next ws

End Sub

我需要根据列标题在多个工作表中删除行,因为列名可能会更改(M到其他内容),但每个工作表中的标题都相同。

3 个答案:

答案 0 :(得分:1)

我假设列的标题位于每个工作表的第一行:

Sub DeleteProducts()

Dim LR as Long, LC as Long, i As Long, j As Long
Dim RNG As Range
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Sheets

    LC = ws.Cells(1, Columns.Count).End(xlToRight).Column
    For i = LC To 2 Step -1
        If ws.Cells(1, i) = "YOURnameHERE" Then
            LR = ws.Cells(Rows.Count, i).End(xlUp).Row
            Exit For
        End If
    Next

    For j = LR To 2 Step -1
        If ws.Cells(j, i).Value <> "Production" Then ws.Cells(j, i).EntireRow.Delete shift:=xlUp
    Next

Next ws

End Sub

这将找到列的名称,然后将i存储在该列的编号中。有了这些信息,您就可以找到该列的最后一行,并查找不是=“生产”的每个值。

我还纠正了其他一些代码,只是为了让它更清洁。

答案 1 :(得分:0)

请使用 Range.Find 查找目标列。修改了下面的代码。

Sub DeleteProducts()

Dim LR, i As Long
Dim RNG As Range
Dim ws As Worksheet
Dim rngTargetColumn as range


For Each ws In ActiveWorkbook.Sheets
    Set rngTargetColumn = ws.Range("1:1").Find("*<Column Heading>*") 'Replace <Column Heading> with your column  header string
    if not rngTargetColumn is Nothing then
        LR = ws.Cells(Rows.Count, rngTargetColumn.Column).End(xlUp).Row

        For i = LR To 2 Step -1
            If ws.Cells(i, rngTargetColumn.Column).Value <> "Production" Then
                    ws.Cells(i, rngTargetColumn.Column).EntireRow.Delete shift:=xlUp
            End If
        Next i
        Set rngTargetColumn = Nothing
    End If
Next ws
End Sub

答案 2 :(得分:0)

她是我完成任务的镜头。代码在所有工作表的第一行中搜索所需的标题。如果找到标题,则在找到标题的列中继续搜索“生产”。

编辑:对代码进行了一些小的清理。

Sub DeleteRowProduction()

Dim Header As Range
Dim FoundCell As Range
Dim ws As Worksheet
Dim HeaderToFind As String
Dim ValueToFind As String

HeaderToFind = "aaa"
ValueToFind = "Production"

For Each ws In Worksheets

    Set Header = ws.Rows(1).Find(what:=HeaderToFind, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)

    If Not Header Is Nothing Then

        Set FoundCell = ws.Columns(Header.Column).Find(what:=ValueToFind, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)

        Do While Not FoundCell Is Nothing
            ws.Rows(FoundCell.Row).Delete
            Set FoundCell = Nothing
            Set FoundCell = ws.Columns(Header.Column).Find(what:=ValueToFind, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
        Loop

    End If

Next ws

End Sub