VBA。 如果一个单元格为空，则删除一行中的多个单元格

Question

我在 excel 表中有多个列......比如说A1:D10 。 我想在 C 列中找到任何空白单元格，删除该单元格以及同一行的 A、B 和 D 单元格，然后向上移动。 但仅限于A1:D10的范围内。 我在此 Excel 表中还有其他信息，我想保留在其原始位置之外的范围。 因此我不能使用这样的东西：

.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

我也不能像下面这样工作，因为它只会向上移动单列，而不是所有四列。

Set rng = Range("A1:D10").SpecialCells(xlCellTypeBlanks)
rng.Rows.Delete Shift:=xlShiftUp

Answer 1

如果在列中没有数据A到D低于排10，你不想动了起来，然后SpecialCells和Delete Shift Up可以使用这样的

Sub Demo1()
    Dim ws As Worksheet
    Dim TestColumn As Long
    Dim StartColumn As Long
    Dim EndColumn As Long
    Dim FirstRow As Long
    Dim LastRow As Long

    Dim i As Long
    Dim rng As Range, arr As Range

    ' set up reference data
    Set ws = ActiveSheet '<~~ update as required
    TestColumn = 3  'C
    StartColumn = 1 'A
    EndColumn = 4   'D
    FirstRow = 1
    LastRow = 10

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With ws
        On Error Resume Next
            Set rng = .Range(.Cells(FirstRow, TestColumn), .Cells(LastRow, TestColumn)).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0

        If Not rng Is Nothing Then
            For Each arr In rng.Areas
                arr.EntireRow.Resize(, EndColumn - StartColumn + 1).Delete Shift:=xlShiftUp
            Next
        End If
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

如果在列中的数据A到D低于排10，你不要想向上移动，则可以使用Cut和Paste ，这样

Sub Demo()
    Dim ws As Worksheet
    Dim TestColumn As Long
    Dim StartColumn As Long
    Dim EndColumn As Long
    Dim FirstRow As Long
    Dim LastRow As Long

    Dim i As Long

    ' set up reference data
    Set ws = ActiveSheet '<~~ update as required
    TestColumn = 3  'C
    StartColumn = 1 'A
    EndColumn = 4   'D
    FirstRow = 1
    LastRow = 10

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With ws
        If IsEmpty(.Cells(LastRow, TestColumn)) Then
            .Cells(LastRow, StartColumn).Resize(1, EndColumn - StartColumn + 1).Clear
        End If
        For i = LastRow - 1 To FirstRow Step -1
            If IsEmpty(.Cells(i, TestColumn)) Then
                .Range(.Cells(i + 1, StartColumn), .Cells(LastRow, EndColumn)).Cut .Cells(i, StartColumn)
            End If
        Next
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Answer 2

使用变体数组方法

Sub test2()
    Dim rngDB As Range, vDB As Variant
    Dim i As Integer, j As Integer, n As Integer
    Dim k As Integer

    Set rngDB = Range("a1:d10")

    vDB = rngDB

    n = UBound(vDB, 1)
    For i = 1 To n
        If IsEmpty(vDB(i, 3)) Then
            For j = 1 To 4
                If j <> 3 Then
                    vDB(i, j) = Empty
                End If
            Next j
        End If
    Next i
    For j = 1 To 4
        If j <> 3 Then
            For i = 1 To n - 1
                For k = i To n - 1
                    If vDB(k, j) = Empty Then
                        vDB(k, j) = vDB(k + 1, j)
                        vDB(k + 1, j) = Empty
                    End If
                Next k
            Next i
        End If
    Next j
    rngDB = vDB
End Sub

Answer 3

下面将通过在第 3 列中查找空单元格并删除该行并仅在该行中向上移动来满足您的要求。

Sub deleteEmptyRow()
Dim i As Integer

    For i = 1 To 10
        If Cells(i, 3) = "" Then
            Range(Cells(i, 1), Cells(i, 4)).delete Shift:=xlUp
        End If
    Next i

End Sub