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) = "" 部分，它工作并删除所有行，其中colum 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

您可以使用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

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并且有一个＆＃34;＆＃34;在2018年的第3行＆＃39;表格，然后它将始终卡在Zeile1 = 3线上。你将永远回到那个＆＃34;＆＃34;在2018年的第3行＆＃39;表。

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

另一种方法是简单地使用内部数组并写出具有有效行的新数据集。

非常快。

如果你的数据集有公式，那么你将不得不使用额外的代码，但如果它只是常量，那么下面应该这样做：

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

当它们“显得空”时删除“空”行

4 个答案: