Question

我正在尝试根据分布在多个列中的多个条件删除行。基本上，我在A列中有一个名单列表，在第1行有一个计划列表。

enter image description here

问题是，有时候有一个计划1，有时候有一个计划2，有时候两者都有，如上图所示。计划也改变了他们所在的栏目。

我正在尝试编写一些vba来查看标题中是否存在其中任何一个计划，如果其中一个或两个确实存在，则删除两个人都空白的行。在上面的图片中，与＆＃34; Barry Bonds＆＃34;需要删除。

到目前为止，我有一种方法可以删除一列中的空白，但我不知道如何为多列删除空白，或者在计划名称之间切换（即计划1或计划2）。 / p>

Sub Delete_non_used_Loc()

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim Acell As Range
Dim rng As Range
Dim col As Long
Dim Lastrow As Long
Dim colName As String

'Value for deleting blanks
Dim DelTerm As Range
Set ws = Sheets("hello")
'This statement finds the Plan in the  column in the carrier report.
With ws
        Set Acell = .Range("A1:Z2").Find(What:="Plan 1", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
'If the plan column is found, then:
If Not Acell Is Nothing Then
    col = Acell.Column
    colName = Split(.Cells(, col).address, "$")(1)
    Lastrow = .Range(colName & .Rows.Count).End(xlUp).Row
    'This is the range of rows in the column specified (Plan 1).
    Set rng = .Range(colName & "2:" & colName & Lastrow)
'Finds and deletes terminated employees by searching for blanks via the Plan 1 column.
 Do
    Set DelTerm = rng.Find("", LookIn:=xlValues) 'Finds the blanks.
    If Not DelTerm Is Nothing Then DelTerm.EntireRow.Delete 'Deletes the row     where blanks are found.
Loop While Not DelTerm Is Nothing
Else
    MsgBox "Could not delete blank employees!"
End If
End With

End Sub

Answer 1

更新了答案 更具挑战性，但绝对可以做到！为了维护这些＆＃34;随机数据字段＆＃34;，我们将利用一个Collection对象来保存所有感兴趣的列号（即包含单词＆＃34; Plan＆＃34; ）。

通过遍历第一行并构建Collection，我们可以稍后循环遍历Collection并仅查看重要的单元格。

以下评论很多的代码应该可以解决问题。

Option Explicit
Public Sub DeleteBlankRowsRev2()

    Dim wks As Worksheet
    Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long
    Dim varColItem As Variant
    Dim blnAllBlank As Boolean
    Dim col As Collection
    Set col = New Collection

    'First things first: we identify our basic variables
    Set wks = ThisWorkbook.Worksheets("hello")

    With wks
        'Now that our sheet is defined, we'll find the last row and last column
        lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row
        lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).Column

        'Awesome! With the last row and column in our pocket, we now
        'know a lot about the data range we will be checking for blanks

        'Here we loop through the first row, adding any column number
        'that contains the word "plan"
        For lngIdx = 1 To lngLastCol
            If InStr(UCase(CStr(.Cells(1, lngIdx))), "PLAN") Then
                col.Add lngIdx
            End If
        Next lngIdx

        'Since we need to delete rows, we start from the bottom and move up
        For lngIdx = lngLastRow To 1 Step -1

            'Start by setting a flag to immediately stop checking
            'if a cell is NOT blank
            blnAllBlank = True

            'Loop through all the column numbers contained in our collection
            For Each varColItem In col

                'If the cell is NOT blank, change the flag to False
                'then exit this For loop
                If .Cells(lngIdx, CInt(varColItem)) <> "" Then
                    blnAllBlank = False
                End If
                If Not blnAllBlank Then Exit For
            Next varColItem

            'Delete the row if the blnBlank variable is True
            If blnAllBlank Then
                .Rows(lngIdx).Delete
            End If

        Next lngIdx
    End With

    'That's it -- we're done!
    MsgBox "Script complete!"

End Sub

原始答案 下面的评论很多的代码应该可以解决问题。

简而言之，我们：

确定计划数据的范围
循环通过范围BACKWARDS
对于每一行，如果上面＃1中定义的空间中的每个单元格都为空，则删除该行

不要忘记庆祝！

Option Explicit
Public Sub DeleteBlankRows()

    Dim wks As Worksheet
    Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
        lngColCounter As Long
    Dim blnAllBlank As Boolean

    'First things first: we identify our basic variables
    Set wks = ThisWorkbook.Worksheets("hello")

    With wks
        'Now that our sheet is defined, we'll find the last row and last column
        lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row
        lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).Column

        'Awesome! With the last row and column in our pocket, we can
        'loop over the full range (whether it only has 2 columns or 4)

        'Since we need to delete rows, we start from the bottom and move up
        For lngIdx = lngLastRow To 1 Step -1

            'Start by setting a flag to immediately stop checking
            'if a cell is NOT blank and initializing the column counter
            blnAllBlank = True
            lngColCounter = 2

            'Check cells from left to right while the flag is True
            'and the we are within the farthest-right column
            While blnAllBlank And lngColCounter <= lngLastCol

                'If the cell is NOT blank, trip the flag and exit the loop
                If .Cells(lngIdx, lngColCounter) <> "" Then
                    blnAllBlank = False
                Else
                    lngColCounter = lngColCounter + 1
                End If

            Wend

            'Delete the row if the blnBlank variable is True
            If blnAllBlank Then
                .Rows(lngIdx).Delete
            End If

        Next lngIdx
    End With

    'That's it -- we're done!
    MsgBox "Script complete!"

End Sub

根据多个条件删除空白行

1 个答案: