刪除「空」行時，他們只是「顯示爲空」

Question

我無法設法清理「空行」的數據。刪除「0」沒有問題，但那些空的單元格不是空的，而是其中包含「空字符串」之類的內容。

Sub Reinigung() 

Application.ScreenUpdating = False  
Application.EnableEvents = False  

ListeEnde3 = ThisWorkbook.Sheets("input").Cells(Rows.Count, 1).End(xlUp).Row 
For Zeile1 = 2 To ListeEnde3 

     If ThisWorkbook.Sheets("input").Cells(Zeile1, 14) = "0" Or ThisWorkbook.Sheets("2018").Cells(Zeile1, 14) = "" Then 
     ThisWorkbook.Sheets("input").Rows(Zeile1).Delete 
     Zeile1 = Zeile1 - 1 
     Else 
     End If 

Next 

' ThisWorkbook.Sheets("import").Columns(14).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

Application.ScreenUpdating = True 
Application.EnableEvents = True 

End Sub 

該代碼只是凍結我的excel，如果我離開了 thisWorkbook.Sheets("2018").Cells(Zeile1, 14) = "" 部分，它的工作原理，並刪除所有行，其中科拉姆14包含一個「0」。

如果我檢查顯示爲空白的單元格爲= isblank，它將返回「false」。單元中沒有「空間」，也沒有「'」。

怎麼辦？

編輯

第一提示後我的代碼看起來像現在這樣：

Sub Reinigung() 

Dim ListeEnde3 As Long 
Dim Zeile1 As Long 

Application.ScreenUpdating = False  
Application.EnableEvents = False  

ListeEnde3 = ThisWorkbook.Sheets("import").Cells(Rows.Count, 1).End(xlUp).Row 
For Zeile1 = ListeEnde3 To 2 Step -1 
    Set rngX = ThisWorkbook.Sheets("import").Cells(Zeile1, 14) 
    If (rngX = "0" Or rngX = "") Then 'or rngY = vbNullString 
     ThisWorkbook.Sheets("import").Rows(Zeile1).Delete 
    End If 
Next Zeile1 

' ThisWorkbook.Sheets("import").Columns(14).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

Application.ScreenUpdating = True 
Application.EnableEvents = True 

End Sub 

Excel中仍然崩潰/凍結（我等了5分鐘），但由於代碼運行「順利地」與F8我想用更少的數據給它一個鏡頭：它的工作原理！

如果我沒有減少數據，則有〜70000行檢查。我讓它在720行上運行，它工作。

任何方式來調整代碼的方式，它可以處理70000 +行？我不認爲它會太多。

謝謝！

Answer 1

另一種方法是簡單地使用內部數組並寫出具有有效行的新數據集。

它速度非常快。

如果你的數據集有公式，那麼你將不得不使用額外的代碼，但如果它是常量只，然後在下面的應該做的：

Sub Reinigung() 
    'Here I test with column E to Z, set Ranges appropriately 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 

    Dim ListeEnde3 As Long, x As Long, y As Long 
    'last row of data - set to column of non-blank data 
    ListeEnde3 = ThisWorkbook.Sheets("import").Cells(Rows.Count, 5).End(xlUp).Row 

    Dim ws As Worksheet 
    Set ws = ThisWorkbook.Sheets("import") 

    Dim startCell As Range 
    'set to whatever cell is the upper left corner of data 
    Set startCell = ThisWorkbook.Sheets("import").Range("E1") 

    Dim arr As Variant, arrToPrint() As Variant 
    'Get rightmost column of data instead of hardcoding to "Z" 
    'write dataset into an array 
    arr = ws.Range(startCell, ws.Range("Z" & ListeEnde3)).Value 
    x = UBound(arr) - LBound(arr) + 1   'num of rows of data 
    y = UBound(arr, 2) - LBound(arr, 2) + 1 'num of columns of data 

    ReDim arrToPrint(1 To x, 1 To y) 'array to hold valid/undeleted data 

    Dim i As Long, j As Long, printCounter As Long, arrayColumnToCheck as Long 
    arrayColumnToCheck = 14 - startCell.Column + 1 '14 is column N 
    For i = 1 To x   
     If arr(i, arrayColumnToCheck) <> 0 And arr(i, arrayColumnToCheck) <> vbNullString Then 
       printCounter = printCounter + 1 
       For j = 1 To y 
        'put rows to keep in arrToPrint 
        arrToPrint(printCounter, j) = arr(i, j) 
       Next j 
     End If 
    Next i 
    'Print valid rows to keep - only values will print - no formulas 
    startCell.Resize(printCounter, y).Value = arrToPrint 
    'Delete the rows with zero & empty cells off the sheet 
    startCell.Offset(printCounter).Resize(ListeEnde3 - printCounter, y).Delete xlShiftUp 

    Application.ScreenUpdating = True 
    Application.EnableEvents = True 

End Sub 

Answer 2

您可以添加的IsEmpty到您的代碼來檢查細胞填充

Sub Reinigung() 

Application.ScreenUpdating = False 
Application.EnableEvents = False 

ListeEnde3 = ThisWorkbook.Sheets("input").Cells(Rows.Count, 1).End(xlUp).Row 
For Zeile1 = 2 To ListeEnde3 
    Set rngX = ThisWorkbook.Sheets("input").Cells(Zeile1, 14) 
    Set rngY = ThisWorkbook.Sheets("2018").Cells(Zeile1, 14) 
    If (rngX = "0" And (Not IsEmpty(rngX))) Or (rngY = "") Then 
     ThisWorkbook.Sheets("input").Rows(Zeile1).Delete 
     Zeile1 = Zeile1 - 1 
    End If 
Next 

' ThisWorkbook.Sheets("import").Columns(14).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

Application.ScreenUpdating = True 
Application.EnableEvents = True 

End Sub 

Answer 3

不是一個好主意，改變循環計數器：Zeile1 = Zeile1 - 1

而是開始在年底和使用步驟-1你循環以反向工作。 您處於無限循環中，因爲循環不向前移動。如果Zeile = 3，並且'2018'表中第3行有一個「」，那麼它將始終卡在Zeile1 = 3行上。您將一直回到'2018'表格第3行的「」。

For Zeile1 = ListeEnde3 To 2 Step -1 
    Set rngX = ThisWorkbook.Sheets("input").Cells(Zeile1, 14) 
    Set rngY = ThisWorkbook.Sheets("2018").Cells(Zeile1, 14) 
    If (rngX = "0" Or rngY = "") Then 'or rngY = vbNullString 
     ThisWorkbook.Sheets("input").Rows(Zeile1).Delete 
    End If 
Next Zeile1 

Answer 4

您可以使用AutoFilter並刪除可見行（未測試）：

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("import") 
ws.UsedRange.AutoFilter 14, Array("=0", "="), xlFilterValues 
ws.UsedRange.Offset(1).EntireRow.Delete 
ws.AutoFilterMode = False