Question

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

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

所有代码实际上都是将工作表放在一个工作簿中，将内容复制到新工作簿的工作表中并格式化日期。但是，我不能为我的生活找出如何获取删除行的代码片段。

Answer 1

尝试这个尺寸。它效率不高，只适用于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

Answer 2

虽然我无法实际删除行并希望进一步理解为什么公式干扰删除空行，但我能够通过对数据进行排序来删除空行，以便将空行移动到表底部。

删除行 - 代码确实有效，但不在现有宏中

2 个答案: