Question

我道歉，如果这是重复的，因为我一直在寻找并且没有找到答案。我是VBA的新手，他们是如何构建循环的。我正在尝试进行搜索和比较。我需要比较第一行中的值以查看它们是否与第二行匹配，如果不匹配则继续前进到下一行。请参阅下面的代码（它运行时没有错误，因为我无法找到任何存在的值，因为我可以手动搜索并找到它们）

这个数据集可能非常大，所以我想尽可能高效地编写它，并且不确定哪些循环结构会更快地执行。我需要比较第21列中的值，看看是否有重复值，如果有，那么我需要查看相应行的第22列中的值是否相同，如果是，那么我想去RowB中的下一行，否则如果它们不是相同的值，那么我想检查第4行中两个日期的值，看看它们是否在彼此的2个月内。如果他们不继续寻找。

Dim RowsCount As Integer
Dim ColCount As Integer
RowsCount = Cells(Rows.Count, 1).End(xlUp).Row
ColCount = Cells(1, Columns.Count).End(xlToLeft).Column

Dim RowA As Integer
Dim RowB As Integer
Dim GroupA As Variant
Dim GroupB As Variant
Dim CounterA As Variant
Dim CounterB As Variant
Dim RevDateA As Date
Dim RevDateB As Date
Dim RevDateDiff As Variant

RowA = 2
RowB = 3
Do While RowA <= RowsCount
GroupA = Cells(RowA, 21).Value
CounterA = Cells(RowA, 22).Value
RevDateA = Cells(RowA, 4).Value
    Do While RowB <= RowsCount
    GroupB = Cells(RowB, 21).Value
    CounterB = Cells(RowB, 22).Value
    RevDateB = Cells(RowB, 4).Value
        If GroupA = GroupB Then
            If CounterA = CounterB Then 'go down 1 row in B and repeat
            Else
                If RevDateB - RevDateA < 62 Then
                'highlight row b and move on
                Rows(RowB).Select
                Application.CommandBars.ExecuteMso "CellFillColorPicker"
                Else
                End If
            End If
        Else 'go down 1 row in B and repeat check
        End If

    RowB = RowB + 1
    Loop

RowA = RowA + 1
Loop

Answer 1

这是找到行到行欺骗的好方法

Private Sub findit()

Dim bringIn As Variant

bringIn = ThisWorkbook.Sheets("Sheet1").UsedRange
rowC = ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count

For i = LBound(bringIn, 1) To UBound(bringIn, 1)
    If i = rowC Then
        'nothing
    Else
        If bringIn(i, 1) = bringIn(i + 1, 1) Then
            ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Interior.ColorIndex = 37
        End If
    End If
Next i

End Sub

Answer 2

加速代码的最佳方法不是优化循环，而是改变访问Excel数据的方式。始终引用Cells比将范围转换为数组和枚举数组要慢得多。

此处有更多详情： Arrays And Ranges In VBA

因此，在您的示例中，您可以先将Range转换为Array，然后枚举Array。这是你的代码转换为使用数组（2个数组 - 一个用于组，在列U和V中计数，第二个用于D列中的日期 - 添加了一些注释）

Dim RowsCount As Long
Dim RowA As Long
Dim RowB As Long
Dim Arr() As Variant
Dim ArrDates As Variant
Dim rangeDefinition As String
Dim rangeDates As String

    RowsCount = Cells(Rows.Count, 1).End(xlUp).Row

    rangeDefinition = "U1:V" & RowsCount ' Here define range for groups and counts - columns U and V
    rangeDates = "D1:D" & RowsCount ' Here define range for dates - column D
    Arr = Range(rangeDefinition) ' Here convert groups and counts to array
    ArrDates = Range(rangeDates) ' Here convert dates to array

    RowA = 2
    RowB = 3
    Do While RowA <= RowsCount
        Do While RowB <= RowsCount
            If Arr(RowA, 1) = Arr(RowB, 1) Then ' Compare U column - groups
                If Arr(RowA, 2) = Arr(RowB, 2) Then ' Compare V column - counts -> go down 1 row in B and repeat
                Else
                    If ArrDates(RowB, 1) - ArrDates(RowA, 1) < 62 Then
                    ' Check dates - Column D -> highlight row b and move on
                    Rows(RowB).Select
                    Application.CommandBars.ExecuteMso "CellFillColorPicker"
                    Else
                    End If
                End If
            Else 'go down 1 row in B and repeat check
            End If
        RowB = RowB + 1
        Loop
    RowA = RowA + 1
    Loop

VBA多循环匹配条件

2 个答案: