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

这是Windows 7上的Excel 2010。

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

1. Approved列的位置发生了变化，所以我不能只做Col（“R”），SpecialCells（xlBlanks）.EntireRow.Delete。 我尝试在A1：Z5中search“批准”（因为总是less于26行），并selectfind的列。
2. 大部分数据都是从前一个月的文档中提取出来的，因此一些“空白”单元格会填充一个vlookup。 我尝试通过首先select所有数据并粘贴为值来解决此问题。

这是当前的代码：

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行以下，即使其中一些单元格为空白。 如果我用最后一行replace

 approved_column.select 

它会select整个列，因为它应该。 这使我相信这个问题是与我的删除方法。

Answer 1

如果您有由公式返回的长度为零的string，则不足以将公式结果还原为其值。 您需要使用Range.TextToColumns方法快速扫描列，使用固定宽度并将列的值返回到其原始单元格以使单元格真正为空。

 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函数将计算空白计数中的零长度string，以便在继续之前确定是否存在空白单元格。 使用COUNTIF函数确保在第一行中有一个带有“批准”的列标题。

Answer 2

试试这个（基于删除行优化的解决scheme）

 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 

---

帮手function：

 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