VBA-如何更快地删除和保留符合条件的数据 [英] VBA - How to delete and keep some data with criteria faster
问题描述
我想问一下是否有更好的方法来使此代码更快,因为我有近10万行的数据并且此代码工作得很慢.这是详细信息
I would like to ask if there is a better way to make this code faster because I have data almost 100K rows and this code works pretty slow. Here is the details
我们有两天的数据,A和B包含在U列中,其中某一天总是比另一天晚.
We have two days data, A and B which are contained in the column U, one of these days is always one day later than the other.
我发现EarlyDay假设是A,并且当某行包含A时,我想检查S列是否包含某些值,如果是,则删除该行.另一方面,如果U列中的日期是B,那么我只想保留S具有特定值的行,并删除所有其他值.
I find the earlyDay suppose It's A and when a row contains A I want to check if the column S contains certain values, if yes then delete the row. On the other hand if the day in column U is B, then I want to keep only the rows where S has that certain values and delete all the others.
Sub D( )
Dim earlyDay As Date
earlyDay = Application.WorksheetFunction.Min(Range("u:u"))
Dim N As Long, i As Long
N = Cells(Rows.Count, "U").End(xlUp).Row
For i = N To 2 Step -1
If Cells(i, "U").Value = earlyDay Then
Select Case Cells(i, "S").Value
Case "AAA", "BBB", "CCC"
Cells(i, "U").EntireRow.Delete
End Select
Else
Select Case Cells(i, "S").Value
Case "AAA", "BBB", "CCC"
Case Else
Cells(i, "S").EntireRow.Delete
End Select
End If
Next i
End Sub
推荐答案
假设您的数据看起来像这样
Let's say your data looks like this
您提到了
- 您有25列
- 对于早期,如果
Col U = Early Day
和Col S = AAA,BBB或CCC
,则将其删除 - 对于以后的日子,如果
Col U = Early Day
和Col S<>AAA,BBB或CCC
,然后将其删除 - 以后的日子比早的日子多1天.
- You have 25 columns
- For early day, if the
Col U = Early Day
andCol S = AAA,BBB or CCC
then delete it - For later day, if the
Col U = Early Day
andCol S <> AAA,BBB or CCC
then delete it - later day is 1 day greater than early day.
如果上述正确,则删除后的数据将如下所示
If the above is correct then your data, after deleting, will look like this
正如我在您的帖子下方的评论中提到的那样,使用数组会更快,我将使用该方法.
As I mentioned in the comment below your post that using array will be faster, I am going to use that approach.
尝试此代码.我已经注释了该代码,因此您在理解它时不会遇到问题.
Try this code. I have commented the code so you will not have a problem understanding it.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim earlyDay As Date, laterDay As Date
Dim lRow As Long, i As Long, j As Long
Dim rng As Range, delRange As Range
Dim tmpArray As Variant
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Find last row of column U
lRow = .Range("U" & .Rows.Count).End(xlUp).Row
'~~> Set your Early and Later day here
earlyDay = Application.WorksheetFunction.Min(.Range("U1:U" & lRow))
laterDay = DateAdd("d", 1, earlyDay)
'~~> Identify your range
Set rng = .Range("A1:Y" & lRow)
'~~> Transfer it to array
tmpArray = rng.Value
'~~> Loop through the array and clear unnecessary rows
For i = LBound(tmpArray) To UBound(tmpArray)
If tmpArray(i, 21) = earlyDay Then
Select Case tmpArray(i, 19)
Case "AAA", "BBB", "CCC"
For j = 1 To 25
tmpArray(i, j) = ""
Next j
End Select
ElseIf tmpArray(i, 21) = laterDay Then
Select Case tmpArray(i, 19)
Case "AAA", "BBB", "CCC"
Case Else
For j = 1 To 25
tmpArray(i, j) = ""
Next j
End Select
End If
Next i
'~~> Clear Sheet for pasting new output
.Cells.ClearContents
'~~> Transfer data from array to worksheet
.Range("A1").Resize(UBound(tmpArray), 25).Value = tmpArray
'~~> Find new last row
lRow = .Range("U" & .Rows.Count).End(xlUp).Row
'~~> Identify rows which are blank
For i = 2 To lRow
If Application.WorksheetFunction.CountA(.Range("A" & i & ":Y" & i)) = 0 Then
If delRange Is Nothing Then
Set delRange = .Range("A" & i & ":Y" & i)
Else
Set delRange = Union(delRange, .Range("A" & i & ":Y" & i))
End If
End If
Next i
'~~> Delete blank rows
If Not delRange Is Nothing Then delRange.Delete shift:=xlUp
End With
End Sub
这篇关于VBA-如何更快地删除和保留符合条件的数据的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!