Удаление строк и перемещение всех рядов вместе

Question

Мне нужно найти лучший и быстрый способ, чтобы добиться удаления строк с Y в столбце A а затем перемещения всех оставшихся строк вверх, чтобы не осталось пустых строк, как показано ниже.

Col A    Col B    Col C
Y        TOM      12
O        JOHN     11
Y        FRED     12
         TOM      12
O        JOHN     12
         TOM      12
Y        JOHN     12
Y        TOM      12
Y        JOHN     12
         FRED     10
         JOHN     12

Выше, как выглядит таблица вначале. Я хотел бы иметь возможность нажать кнопку или две, и это будет выглядеть так:

Col A    Col B    Col C
O        JOHN     11
         TOM      12
O        JOHN     12
         TOM      12
         FRED     10
         JOHN     12

Вот как мне это нужно, чтобы посмотреть в конце.

Надеюсь, кто-то может мне помочь.

С наилучшими пожеланиями Наташа Уилсон

Answer 1

Скопируйте следующее в обычный модуль vba (используйте Alt - F11, чтобы открыть редактор Visual Basic). После добавления кода в существующий или новый обычный модуль измените свойства Const мере необходимости. Имя листа - это имя, отображаемое на вкладке листа. Чтобы запустить код, используйте Alt - F8, чтобы открыть диалоговое окно Macro, и дважды щелкните (запустить) Delete_Rows .

ПРЕДУПРЕЖДЕНИЕ Невозможно отменить удаления, сделанные этим макросом, и, следовательно, буфер отмены очищен. Другими словами; это действие не будет отображаться в Edit - Undo и Ctrl - z не будет иметь никакого эффекта.

Option Explicit
Public Sub Delete_Rows()

  ' WARNING: Cannot undo deletions made by this macro and therefore
  '   the Undo Buffer Is Cleared. In other words; this action will
  '   not appear in "Edit - Undo" and Ctrl-z will have no effect.

  ' Delete Rows if row value in value_Column is delete_On_Value.
  ' value_Column must include start_on row number (e.g. A1 or C3)

  ' For speed, only process rows being used <= max_Row.
    Const valueColumn = "A2" ' Beginning Cell (row and column) to consider.
    Const maxRow = "" ' Last row number. If "", rest of rows in use.
    Const deleteOnValue = "Y"
    Const deletionSheetName = "Sheet12"
    Const deleteWarn = True

   '-------------------------------------------------------
   'All code from here on - no more user modifiable setting
   '

    Dim dSht As Worksheet
    Dim resetLastCell As Range
    Dim deleteRange As Range
    Dim r As Range
    Dim rangeStart() As String
    Dim lastRow As String
    Dim tmpEnableEvents As Boolean
    Dim tmpScreenUpdating As Boolean

    On Error Resume Next
    Set dSht = Worksheets(deletionSheetName)
    On Error GoTo 0
    If dSht Is Nothing Then
        MsgBox "Worksheet Named: '" & deletionSheetName & "' not found.", _
            vbExclamation, "Deletion Macro - Error"
        Exit Sub
    End If

    Set resetLastCell = dSht.UsedRange ' call and discard to reset LastCell
    lastRow = dSht.Range(valueColumn).SpecialCells(xlCellTypeLastCell).Row
    If maxRow <> "" Then
       If Val(lastRow) > Val(maxRow) Then lastRow = maxRow
    End If
    rangeStart = Split(dSht.Range(valueColumn).Address(True, False), "$")
    If Val(rangeStart(1)) > Val(lastRow) Then
        If deleteWarn Then
            MsgBox "No used rows beginnig at start row '" & rangeStart(1) _
                & "'.", vbInformation, "Deletion Macro - Exiting"
        End If
        Exit Sub
    End If
    tmpEnableEvents = Application.EnableEvents
    Application.EnableEvents = False
    tmpScreenUpdating = Application.ScreenUpdating
    Application.ScreenUpdating = False

    For Each r In dSht.Range(valueColumn & ":" & rangeStart(0) & lastRow)
        If IsEmpty(r) Then
        ElseIf CStr(r.Value2) = vbNullString Then
        ElseIf r = deleteOnValue Then
            If deleteRange Is Nothing Then
                Set deleteRange = r
            Else
                Set deleteRange = Union(deleteRange, r)
            End If
        End If
    Next r
    If deleteRange Is Nothing Then
        If deleteWarn Then
            MsgBox "No rows to delete.", vbInformation, _
                "Deletion Macro - Exiting"
        End If
    ElseIf deleteWarn Then
        If 1 = MsgBox("Delete " & deleteRange.Count & " row(s) from '" & _
            deletionSheetName & "' tab?", vbQuestion + vbOKCancel, _
            "Deletion Macro - Confirmation") _
        Then
            deleteRange.EntireRow.Delete
        End If
    Else ' no warning - just delete
        deleteRange.EntireRow.Delete
    End If
    Application.ScreenUpdating = tmpScreenUpdating
    Application.EnableEvents = tmpEnableEvents
End Sub