如何删除没有任何值的行(使用Excel VBA)?

时间:2017-01-04 21:53:16

标签: excel vba excel-vba

我正在使用Excel VBA脚本来清理电子表格(首先我删除带有空格的行,然后我找到/替换一些文本以便更加总结)。

我想删除受访者未回答任何调查问题的行。 包含前几列(A,B,C)中的一些数据,例如其IP地址等。调查答案位于第Q3列,直到AC列($ Q4到$) AC)这是截图:

enter image description here

但如果用户没有回答任何调查问题,我想删除该行。

我的VBA脚本在这里:

Sub Main()
    ReplaceBlanks    
    Multi_FindReplace   
End Sub

Sub ReplaceBlanks()
    On Error Resume Next 
    Worksheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
End Sub

Sub Multi_FindReplace() 'PURPOSE: Find & Replace a list of text/values throughout entire workbook 'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

    Dim sht As Worksheet Dim fndList As Variant 
    Dim rplcList As Variant Dim x As Long

    fndList = Array("Mostly satisfied", "Completely satisfied", "Not at all satisfied")
    rplcList = Array("satisfied", "satisfied", "unsatisfied")

    'Loop through each item in Array lists
    For x = LBound(fndList) To UBound(fndList)
        'Loop through each worksheet in ActiveWorkbook
        For Each sht In ActiveWorkbook.Worksheets
            sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
        Next sht
    Next x
End Sub

当我在ReplaceBlanks子例程中没有错误处理的情况下运行它时,我收到此错误消息:

  

运行时错误'424':需要对象

到目前为止,只有第二个子程序可以工作(即Multi_FindReplace)。如何修复第一个子例程,以便删除没有响应者答案的行?

2 个答案:

答案 0 :(得分:1)

替换此行,

Worksheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

有了这个,

Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

通过设置或仅以Columns

开头,说明要删除的工作表

您收到的错误是由于它未在Worksheet

之前识别您Columns("$Q:$AC")

如果您需要指定要删除的工作表,可以执行此操作。

Dim ws As Worksheet

Set ws = Sheets("Sheet1")
ws.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

甚至是这个

ActiveSheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

根据评论,如果你有多个空白单元格,你会抛出一个错误,所以如果你在一行中有多个空白单元格而任何空格的单元格确定要删除的整行,这段代码应该为你做

Dim ws As Worksheet
Dim lastrow As Long
Dim rng As Range

Set ws = Sheets("Sheet1")
lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

For i = 2 To lastrow
     If WorksheetFunction.CountA(ws.Range(ws.Cells(i, 17), ws.Cells(i, 21))) = 0 Then
        If Not rng Is Nothing Then
              Set rng = Union(ws.Cells(i, 1), rng)
        Else
              Set rng = ws.Cells(i, 1)
        End If
     End If
Next i

rng.EntireRow.Delete

答案 1 :(得分:0)

我的懒惰方式通常是隐藏非空行,并删除可见的行(未测试):

Cells.SpecialCells(xlCellTypeConstants).EntireRow.Hidden = True
Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
Cells.EntireRow.Hidden = False