删除行-代码确实有效,但在现有宏中无效



我正试图使用以下代码删除工作表中的空行。

Columns("E:E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

它作为一个独立的程序运行得很好,但当我试图在更大的marco中使用它时,它失败了。这是完整的代码:

Sub liquidVolume()
    Dim dateTime As String
    Dim MyPath As String
    MyPath = ThisWorkbook.Path
    Sheets("Volume").Select
    dateTime = Range("i1")

    Sheets("Volume").Select
    Range("A1:E10000").Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Columns("B:B").Select
    Selection.NumberFormat = "dd/mm/yyyy h:mm"

    **Columns("E:E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete**
    ActiveWorkbook.SaveAs Filename:=MyPath & dateTime, FileFormat:=xlCSV

End Sub

代码真正要做的就是在一个工作簿中取一个工作表,将内容复制到新工作簿的工作表中,并设置日期格式。然而,我一辈子都不知道如何让删除行的代码片段发挥作用。

试试这个尺寸。它效率不高,只能在2010版及更新版本中使用。

Option Explicit
Public Sub liquidVolume()
    Dim dateTime As String
    Dim MyPath As String
    Dim shtSource As Worksheet
    Dim shtTarget As Worksheet
    Dim rngSource As Range
    Dim rngTarget As Range
    Dim wb As Workbook

    MyPath = ThisWorkbook.Path
    dateTime = Range("i1")
    Set shtSource = ThisWorkbook.Sheets("volume")
    Set rngSource = shtSource.Range("A1:E10000")
    Set wb = Workbooks.Add
    Set shtTarget = wb.Sheets(1)
    Set rngTarget = shtTarget.Range("A1:E10000")
    rngSource.Copy
    rngTarget.PasteSpecial Paste:=xlPasteValues
    shtTarget.Columns("B").NumberFormat = "dd/mm/yyyy h:mm"
'    Set rngTarget = shtTarget.Columns("E:E").SpecialCells(xlCellTypeBlanks)
    Set rngTarget = EmptyCells(shtTarget.Columns("E:E"))
    If Not rngTarget Is Nothing Then
        rngTarget.EntireRow.Delete
    End If
    'wb.SaveAs Filename:=MyPath & dateTime, FileFormat:=xlCSV
End Sub
Public Function EmptyCells(ByVal rngColumn As Range) As Range
    Dim shtSheet As Worksheet
    Dim lngLastRow As Long
    Dim lngRow As Long
    Dim rngEmptyCells As Range
    Dim intColumn As Integer
    'Determine the sheet the column belongs to
    Set shtSheet = rngColumn.Parent
    'Determine last used row
    lngLastRow = shtSheet.UsedRange.Rows(1).Row + shtSheet.UsedRange.Rows.Count - 1
    'Determine column
    intColumn = rngColumn.Columns(1).Column
    'Determine range with empty cells.
    Set rngEmptyCells = Nothing
    For lngRow = 1 To lngLastRow
        If Len(Trim(shtSheet.Cells(lngRow, intColumn))) = 0 Then
            If rngEmptyCells Is Nothing Then
                Set rngEmptyCells = shtSheet.Cells(lngRow, intColumn)
            Else
                Set rngEmptyCells = Union(rngEmptyCells, shtSheet.Cells(lngRow, intColumn))
            End If
        End If
    Next lngRow
    Set EmptyCells = rngEmptyCells
End Function

虽然我无法实际删除行,并且想进一步了解公式干扰删除空行的原因,但我可以通过对数据进行排序来删除空行,从而将空行移动到工作表的底部。

最新更新