Удалить пустые строки на основе нескольких критериев

Question

Я пытаюсь удалить строки на основе нескольких критериев, распределенных по нескольким столбцам. По сути, у меня есть список имен в столбце A, и список планов через ряд 1.

Проблема в том, иногда есть план 1, иногда есть план 2, а иногда есть и то, и другое, как на приведенной выше картинке. Планы также меняют, в каком столбце они находятся.

Я пытаюсь написать некоторые vba, чтобы увидеть, существует ли какой-либо из этих планов в заголовке, и если один или оба из них существуют, удалите строку, в которой человек пустое в обоих. На картинке выше строка с «Барри-облигациями» должна быть удалена.

До сих пор у меня есть метод удаления пробелов в одном столбце, но я не знаю, как это сделать для более чем одного столбца, или для переключения между именами планов (например, план 1 или план 2).

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

Обновлено Ответ Немного сложнее, но, безусловно, все еще выполнимо! Чтобы сохранить эти «Случайные поля данных», мы воспользуемся объектом Collection, который содержит все интересующие столбцы (т. Е. Любой номер столбца, содержащий слово «План»).

Пройдя через первый ряд и построив 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 

Оригинал ответа Сильно комментируются ниже код следует сделать трюк.

Короче говоря, мы:

1. Определить диапазон данных плана
2. Loop через диапазон ОБРАТНОЙ
3. Для каждой строки, если каждая клетка в пространстве определено в пункте 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