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

您提到了

1. 您有25列
2. 对于早期，如果 Col U = Early Day 和 Col S = AAA，BBB或CCC ，则将其删除
3. 对于以后的日子，如果 Col U = Early Day 和 Col S<>AAA，BBB或CCC ，然后将其删除
4. 以后的日子比早的日子多1天.

1. You have 25 columns
2. For early day, if the Col U = Early Day and Col S = AAA,BBB or CCC then delete it
3. For later day, if the Col U = Early Day and Col S <> AAA,BBB or CCC then delete it
4. 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屋！