刪除行 - 代碼確實有效，但不在現有的宏中

我試圖使用下面的代碼刪除工作表中的空行。刪除行 - 代碼確實有效，但不在現有的宏中

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

所有的代碼確實是採取一個工作表一個工作簿，內容複製到一個新的工作簿的工作表並格式化日期。然而，我不能在我的生活中弄清楚如何獲得刪除行的代碼片段。

來源

2014-09-30 Jake.Ratt

你想刪除哪些工作簿/工作表？設置完成後，它看起來會在新工作簿中刪除它們。 – JNevill 2014-09-30 19:25:00

你說「它失敗」。它會給你一個錯誤信息嗎？什麼是錯誤信息？ – Stepan1010 2014-09-30 19:28:30

我的部分措辭不佳。它根本不會刪除任何東西。沒有錯誤消息 – 2014-10-01 03:28:37

雖然我是不是能夠真正刪除行，並想進一步瞭解爲什麼公式與空白行的刪除干擾，我可以通過排序數據刪除空行，這樣的空行被移動到工作表的底部。

來源

2014-10-08 15:32:31

試試這個大小。它效率不高，它只適用於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

來源

2014-10-02 17:27:13 Barry

刪除行 - 代碼確實有效，但不在現有的宏中

回答

相關問題