如果更改列中的单元格为空白，则删除行

Question

这是 Windows 7 上的 Excel 2010。

我收到电子表格，其中一列称为“已批准”。此列用 x 和空白填充。我想删除该列中所有有空格的行。这是一个简单的问题，但有两个令人困惑的问题：

1. Approved 列的位置发生了变化，所以我不能只做 Columns("R").SpecialCells(xlBlanks).EntireRow.Delete。我尝试通过在 A1:Z5 中搜索“批准”（因为总是少于 26 行）并选择找到它的列来解决这个问题。
2. 大部分数据是从上个月的文档中提取的，因此一些“空白”单元格填充了 vlookup。我尝试通过首先选择所有数据并粘贴为值来解决此问题。

这是当前代码：

Sub DeleteCol()
Range("A1").Select
Range(Selection, Selection.SpecialCells(xlLastCell)).Select
Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

  Dim rngApprove As Range
  Set rngApprove = Range("A1:Z5").Find("Approve")
  If rngApprove Is Nothing Then
    MsgBox "Approved column was not found."
    Exit Sub
  End If
  Dim approved_column As Range
  Set approved_column = rngApprove.EntireColumn
  approved_column.SpecialCells(xlBlanks).EntireRow.Delete
End Sub

复制 + 粘贴作为值按预期工作。但是，行删除只会删除第 1-4 行，并且只保留第 5 行以下的所有内容，即使其中一些单元格是空白的。如果我用

替换最后一行

approved_column.select

它应该选择整个列。这让我相信问题出在我的删除方法上。

Answer 1

试试这个（基于delete rows optimization 解决方案）

Option Explicit

Sub deleteRowsWithBlanks()
    Const KEY_STRING As String = "Approve"
    Dim oldWs As Worksheet, newWs As Worksheet, rowHeights() As Long
    Dim wsName As String, rng As Range, filterCol As Long

    Set oldWs = ActiveSheet
    wsName = oldWs.Name
    Set rng = oldWs.Range("A1:Z5")
    filterCol = getHeaderColumn(rng, KEY_STRING, True)

    If filterCol > 0 Then
        FastWB True
        If rng.Rows.Count > 1 Then
            Set newWs = Sheets.Add(After:=oldWs)
            With oldWs.UsedRange
                .AutoFilter Field:=filterCol, Criteria1:="<>"
                .Copy
            End With
            With newWs.Cells
                .PasteSpecial xlPasteColumnWidths
                .PasteSpecial xlPasteAll
                .Cells(1, 1).Select
                .Cells(1, 1).Copy
            End With
            oldWs.Delete
            newWs.Name = wsName
        End If
        FastWB False
    End If
End Sub

---

辅助函数：

Public Function getHeaderColumn(ByVal rng As Range, ByVal headerName As String, _
                                Optional matchLtrCase As Boolean = True) As Long
    Dim found As Range, foundCol As Long

    If Not rng Is Nothing Then
        headerName = Trim(headerName)
        If Len(headerName) > 0 Then
            Set found = rng.Find(What:=headerName, MatchCase:=matchLtrCase, _
                                 LookIn:=xlFormulas, LookAt:=xlWhole)
            If Not found Is Nothing Then foundCol = found.Column
        End If
    End If
    getHeaderColumn = foundCol
End Function

---

Public Sub FastWB(Optional ByVal opt As Boolean = True)
    With Application
        .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
        .DisplayAlerts = Not opt
        .DisplayStatusBar = Not opt
        .EnableAnimations = Not opt
        .EnableEvents = Not opt
        .ScreenUpdating = Not opt
    End With
    FastWS , opt
End Sub

Public Sub FastWS(Optional ByVal ws As Worksheet = Nothing, _
                  Optional ByVal opt As Boolean = True)
    If ws Is Nothing Then
        For Each ws In Application.ActiveWorkbook.Sheets
            EnableWS ws, opt
        Next
    Else
        EnableWS ws, opt
    End If
End Sub
Private Sub EnableWS(ByVal ws As Worksheet, ByVal opt As Boolean)
    With ws
        .DisplayPageBreaks = False
        .EnableCalculation = Not opt
        .EnableFormatConditionsCalculation = Not opt
        .EnablePivotTable = Not opt
    End With
End Sub

Answer 2

如果公式返回的字符串长度为零，则将公式结果还原为它们的值是不够的。您需要使用 Range.TextToColumns method 快速扫描列，使用固定宽度并将列的值返回到其原始单元格，以使单元格真正空白。

Sub DeleteCol()
    Dim iCOL As Long, sFND As String

    With ActiveSheet
        With .Range(.Cells(1, 1), .Cells(1, 1).SpecialCells(xlLastCell))
            .Value = .Value
        End With
        sFND = "Approve"

        If CBool(Application.CountIf(.Rows(1), sFND)) Then
            iCOL = Application.Match(sFND, .Rows(1), 0)
            If CBool(Application.CountBlank(.Columns(iCOL))) Then
                With .Columns(iCOL)
                    .TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
                                   FieldInfo:=Array(0, 1)
                    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                End With
            End If
        End If
    End With

End Sub

工作表的COUNTBLANK function 将在其空白计数中计算零长度字符串，因此我们可以在继续之前确定是否有空白单元格。使用COUNTIF function 确保第一行中有一个带有“批准”的列标题也是如此。