用空白单元格和标准VBA删除行

我有从A – S的列，我需要删除标题和空白单元格，删除标题的查找条件是“交易”和“源”，但它似乎是跳过行。 我总共有79,000行，但是代码只能达到39,000。 我已经试过了我能find的所有东西。 还没有发生。 我也开始格式化和删除第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 

我尝试了不同的尝试，但不工作。 代码被评论。 谢谢！

Answer 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向上移动。