Question

感谢您的宝贵时间。我正在尝试编写一个脚本，以删除具有数据/正确数据的excel电子表格中的行，而只保留缺少数据/错误的行。当我运行脚本时，它通常可以正常运行，但是我仍然可以找到应删除的行。

Application.ScreenUpdating = False
ThisWorkbook.OpenFile
Range("DP:DP").NumberFormat = "dd/MM/yyyy"

' Removes potential duplicates based on the GPN column
Dim MyRange As Range
Dim LastRow As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Set MyRange = ActiveSheet.Range("A1:EE" & LastRow)
MyRange.RemoveDuplicates Columns:=9, Header:=xlYes

' Copies the report to the second sheet and names it Original
Dim sourceColumn As Range, targetColumn As Range
Set sourceColumn = ActiveWorkbook.Worksheets(1).Columns("A:EE")
Set targetColumn = ActiveWorkbook.Worksheets(2).Columns("A")

sourceColumn.Copy Destination:=targetColumn
ActiveWorkbook.Worksheets(2).Name = "Original"

Dim Today, TooYoung, TooOld As Date
Today = Now()
TooYoung = DateAdd("yyyy", -18, Today)
TooOld = DateAdd("yyyy", -70, Today)
Dim i As Long
Dim StateLength, AgeRange As Boolean
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

' Loops through the entire report
For i = 2 To LastRow

' A check in the State Column to make sure the State is spelled out
' And not a two letter abreviation
If Len(Cells(i, 53).Value) >= 3 Then
    StateLength = True
End If

' A Check in the Birthdate Column to make sure the age is "Logical"
' Not one about the age of 70 and younger than 18
If Cells(i, 120).Value > TooOld Or Cells(i, 120).Value < TooYoung Then
    AgeRange = True
End If

' A giant IF statement that analyzes a row to find a row that has all the 
'stuff filled in right and then deletes that row
 If Not IsEmpty(Cells(i, 22).Value) And _
    Not IsEmpty(Cells(i, 24).Value) And _
    Not IsEmpty(Cells(i, 26).Value) And _
    Not IsEmpty(Cells(i, 48).Value) And _
    Not IsEmpty(Cells(i, 91).Value) And _
    Not IsEmpty(Cells(i, 97).Value) And _
    Not IsEmpty(Cells(i, 120).Value) And _
    StateLength = True And _
    AgeRange = True Then
        'MsgBox "All These Rows are filled in YO"
        Rows(i).Delete
End If

' Highlights Errors where they are in the cells
If IsEmpty(Cells(i, 22).Value) = True Then
    Cells(i, 22).Interior.ColorIndex = 3
End If
If IsEmpty(Cells(i, 24).Value) Then
    Cells(i, 24).Interior.ColorIndex = 3
End If
If IsEmpty(Cells(i, 26).Value) Then
    Cells(i, 26).Interior.ColorIndex = 3
End If
If IsEmpty(Cells(i, 48).Value) Then
    Cells(i, 48).Interior.ColorIndex = 3
End If
If IsEmpty(Cells(i, 91).Value) Then
    Cells(i, 91).Interior.ColorIndex = 3
End If
If IsEmpty(Cells(i, 97).Value) Then
    Cells(i, 97).Interior.ColorIndex = 3
End If
If IsEmpty(Cells(i, 120).Value) Then
    Cells(i, 120).Interior.ColorIndex = 3
End If
If StateLength = False Then
    Cells(i, 53).Interior.ColorIndex = 3
End If
If AgeRange = False Then
    Cells(i, 120).Interior.ColorIndex = 3
End If

' Resets the flags to False for the next iteration
StateLength = False
AgeRange = False 
Next i

它在我正在检查的地方留下包含数据和正确数据的行。但是它似乎删除了很多符合条件的行。我对此很茫然。

不删除Excel中所有正确的行

0 个答案: