删除带有空白单元格和标准 VBA 的行答案

【问题标题】：deleting rows with blank cells and criteria VBA删除带有空白单元格和标准 VBA 的行
【发布时间】：2016-12-08 02:09:48
【问题描述】：

我有来自 A - S 的列，我需要删除标题和空白单元格，我在删除标题时查找的标准是“事务”和“源”，但它似乎在跳过行。我总共有 79,000 行，但代码只到 39,000 行。我已经尝试了所有我能找到的东西。仍然没有任何反应。我也开始格式化和删除第 209 行直到 lastrow。

Option Explicit

Sub Project_M()
Dim lastrow As Long
Dim cc As Long
Dim dd As Long
lastrow = WorksheetFunction.CountA(Columns(1))
Application.ScreenUpdating = False
Call ClearFormats
lastrow = WorksheetFunction.CountA(Columns(1))
Columns(1).Insert shift:=xlToRight

Range("A209:A" & lastrow).Formula = "=ROW()"   'inserting dummy rows
Range("A209:A" & lastrow).Value = Range("A210:A" & lastrow).Value
Range("U209:U" & lastrow).Formula = "=IF(AND(ISERROR(SEARCH(""Transaction"",B209)),ISERROR(SEARCH(""Source"", B209))),1,0)"
Range("U209:U" & lastrow).Value = Range("U209:U" & lastrow).Value

''''' delete headers : only working till row 39,0000
Range("A209:U" & lastrow).Sort Key1:=Range("U209"), Order1:=xlAscending
cc = WorksheetFunction.CountIf(Columns(21), "0")
        If cc <> 0 Then
            Range("A209:U" & cc).Select
            Range("A209:U" & cc).EntireRow.Delete
        lastrow = lastrow - cc
        End If

Range("A209:U" & lastrow).Sort Key1:=Range("A209"), Order1:=xlAscending
Range("U:U").ClearContents
Range("A:A").Delete
ActiveSheet.UsedRange.Columns.AutoFit


End Sub

Sub deleteBlank() 'not working
    Dim lastrow As Integer

    lastrow = Range("A" & rows.Count).End(xlUp).Row

    Range("B2:B" & lastrow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Sub ClearFormats() ' working
  Dim rng As Range
  Dim lastrow As Long
  Dim ws As Worksheet
  lastrow = Range("A" & rows.Count).End(xlUp).Row
  Application.ScreenUpdating = False
  On Error Resume Next
  Set rng = Range("A209:S" & lastrow).SpecialCells(xlCellTypeBlanks)
  On Error GoTo 0
  If Not rng Is Nothing Then
    rng.ClearFormats
  End If

  On Error Resume Next 'not working in deleting blank cells
ws.Columns("A209:S" & lastrow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

End Sub

Sub DeleteExtra() ' not working
Dim Last As Long
Dim i As Long
   Last = Cells(rows.Count, "A").End(xlUp).Row
    For i = Last To 1 Step 1
        If (Cells(i, "A209").Value) = "Transaction" And (Cells(i, "A209").Value) = "Source" And (Cells(i, "A209").Value) = "" And (Cells(i, "A209").Value) = "  " Then
            Cells(i, "A").EntireRow.Delete
        End If
    Next i
End Sub


Sub deleteBlankcells()  '''not working
Dim lastrow As Long
Dim cc As Long
lastrow = WorksheetFunction.CountA(Columns(1))
Range("A209:A" & lastrow).Formula = "=ROW()"   'inserting dummy rows
Range("A209:A" & lastrow).Value = Range("A210:A" & lastrow).Value
Range("U209:U" & lastrow).Formula = "=IF(AND(ISBLANK(A209),ISBLANK(A209)),0,1)"
Range("U209:U" & lastrow).Value = Range("U209:U" & lastrow).Value

Range("A209:U" & lastrow).Sort Key1:=Range("U209"), Order1:=xlAscending
cc = WorksheetFunction.CountIf(Columns(21), "0")
        If cc <> 0 Then
            Range("A209:U" & cc).Select
            Range("A209:U" & cc).EntireRow.Delete
        lastrow = lastrow - cc
        End If

Range("A209:U" & lastrow).Sort Key1:=Range("A209"), Order1:=xlAscending
Range("U:U").ClearContents
Range("A:A").Delete
End Sub

我尝试了不同的尝试，但没有成功。代码已注释。谢谢！

【问题讨论】：

DeleteExtra 中的循环不会执行 - 它应该是 Step -1。
嗨@Comintern！感谢您的答复。是的，我已经尝试过Step -1，但仍然无法正常工作，它会删除所有内容。我只是把它包括在上面以获得想法。谢谢！
DeleteExtra 中的 For 循环内的 If 语句不应该有 Or 而不是 And。 If (Cells(i, "A").Value) = "Transaction" Or (Cells(i, "A").Value)...
嗨@nightcrawler23 我实际上运行它而不是使用and 哈哈。我会尽力。 :D
我尝试过使用Step -1 也使用Or 作为子 DeleteExtra 但没有任何反应。

标签： vba excel

【解决方案1】：

在用户的帮助和想法下，我编写了这个简单的代码并让它工作。归功于他们所有人！干杯！

 Option Explicit
Sub Project_M()
Dim Last As Long
Dim i As Long
Application.ScreenUpdating = False
   Last = cells(rows.Count, "A").End(xlUp).Row
Range("A209:S" & Last).UnMerge
Range("A209:S" & Last).WrapText = False

For i = Last To 209 Step -1
        If (cells(i, "A").Value) = "Source" Or (cells(i, "A").Value) = 0 Or (cells(i, "A").Value) = "End of Report" Or (cells(i, "A").Value) = "Transaction" Then
            cells(i, "A").EntireRow.Delete
        End If
Next i
ActiveSheet.UsedRange.Columns.AutoFit

Application.ScreenUpdating = True
End Sub

从for i = Last 列的最后一行到我要开始格式化的行，删除To 209 和Step -1 以向上移动。

【讨论】：