'afix的数据筛选
Public Sub chooseDate()
MsgBox ("数据筛选开始")
With ActiveSheet
r = 2
starts:
If Sheets("afix").Cells(r, 1) = "" Then GoTo ends
If (Sheets("afix").Cells(r, 1) <= 2.63 And Sheets("afix").Cells(r, 2) >= 18.8) _
Or (Sheets("afix").Cells(r, 1) <= 4.15 And Sheets("afix").Cells(r, 2) >= 40) _
Or (Sheets("afix").Cells(r, 1) <= 5 And Sheets("afix").Cells(r, 2) >= 50.5) _
Or (Sheets("afix").Cells(r, 1) <= 6.17 And Sheets("afix").Cells(r, 2) >= 64.3) _
Or (Sheets("afix").Cells(r, 1) >= 12.74 And Sheets("afix").Cells(r, 2) <= 63.9) _
Or (Sheets("afix").Cells(r, 1) >= 11.48 And Sheets("afix").Cells(r, 2) <= 39.7) _
Or (Sheets("afix").Cells(r, 1) >= 10.47 And Sheets("afix").Cells(r, 2) <= 29.4) _
Or (Sheets("afix").Cells(r, 1) >= 9.46 And Sheets("afix").Cells(r, 2) <= 13.2) _
Or (Sheets("afix").Cells(r, 1) >= 8.19 And Sheets("afix").Cells(r, 2) <= 8.3) _
Or (Sheets("afix").Cells(r, 1) <= 0) _
Or (Sheets("afix").Cells(r, 2) <= 0) _
Then
Sheets("afix").Select
Rows(r & ":" & r).Select '先选择目标sheet页
Selection.Delete Shift:=xlUp
r = r - 1 '考虑下一行上移之后可能还有错的问题
End If
r = r + 1 '下移一行
GoTo starts
ends:
MsgBox ("结束")
End With
End Sub
' 2.63 18.8 4.15 40 5 50.5 6.17 64.3
'12.74 63.9 11.48 39.7 10.47 29.4 9.46 13.2 8.19 8.3
Public Sub chooseDate()
MsgBox ("数据筛选开始")
With ActiveSheet
r = 2
starts:
If Sheets("afix").Cells(r, 1) = "" Then GoTo ends
If (Sheets("afix").Cells(r, 1) <= 2.63 And Sheets("afix").Cells(r, 2) >= 18.8) _
Or (Sheets("afix").Cells(r, 1) <= 4.15 And Sheets("afix").Cells(r, 2) >= 40) _
Or (Sheets("afix").Cells(r, 1) <= 5 And Sheets("afix").Cells(r, 2) >= 50.5) _
Or (Sheets("afix").Cells(r, 1) <= 6.17 And Sheets("afix").Cells(r, 2) >= 64.3) _
Or (Sheets("afix").Cells(r, 1) >= 12.74 And Sheets("afix").Cells(r, 2) <= 63.9) _
Or (Sheets("afix").Cells(r, 1) >= 11.48 And Sheets("afix").Cells(r, 2) <= 39.7) _
Or (Sheets("afix").Cells(r, 1) >= 10.47 And Sheets("afix").Cells(r, 2) <= 29.4) _
Or (Sheets("afix").Cells(r, 1) >= 9.46 And Sheets("afix").Cells(r, 2) <= 13.2) _
Or (Sheets("afix").Cells(r, 1) >= 8.19 And Sheets("afix").Cells(r, 2) <= 8.3) _
Or (Sheets("afix").Cells(r, 1) <= 0) _
Or (Sheets("afix").Cells(r, 2) <= 0) _
Then
Sheets("afix").Select
Rows(r & ":" & r).Select '先选择目标sheet页
Selection.Delete Shift:=xlUp
r = r - 1 '考虑下一行上移之后可能还有错的问题
End If
r = r + 1 '下移一行
GoTo starts
ends:
MsgBox ("结束")
End With
End Sub
' 2.63 18.8 4.15 40 5 50.5 6.17 64.3
'12.74 63.9 11.48 39.7 10.47 29.4 9.46 13.2 8.19 8.3