Условия соответствия нескольких циклов VBA

Прошу прощения, если это дубликат, так как я искал и не нашел ответа. Я новичок в 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

excel vba nested-loops do-while
person Ben    schedule 12.06.2017    source источник
comment
Если у вас будет много данных (и в любом случае это хорошая практика), всегда объявляйте As Long вместо As Integer. Целочисленные переполнения выше ~32 000   -  person Tim Williams    schedule 13.06.2017
comment
Тим Спасибо за эту информацию, я изменю эти переменные на As Long.   -  person Ben    schedule 13.06.2017
comment
Вы можете проверить на неравные значения: If CounterA <> CounterB Then .... Кроме того, вы можете комбинировать проверки критериев, используя And -- If GroupA = GroupB And CounterA <> CounterB And RevDateB - RevDateA < 62 Then ....   -  person Zev Spitz    schedule 13.06.2017

Ответы (2)


arrow_upward
0
arrow_downward

Это довольно хороший способ найти ряд дубликатов.

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
person Doug Coats    schedule 12.06.2017
comment
Есть ли более чистый способ справиться с этим? Я просто вижу, что избавлюсь от одного цикла и заменю его оператором if. У меня есть проверка 3 условий, что все необходимые условия должны быть выполнены, и будет несколько случаев, когда он завершится ошибкой после первого или даже второго случая, и поиск должен продолжаться до конца листа. Затем нужно начать сначала с строки 3 и выполнить проверку для каждой строки ниже. Я знаю, что это займет много вычислительной мощности, но это сложная проверка, которая требует либо 10 минут компьютера, либо человека, возможно, часов. - person Ben; 13.06.2017
comment
Я на 100% уверен, что все эти критерии можно оценить в одной строке. Я только что предоставил более чистый способ проверки дубликатов между строками. ЕСЛИ вы более четко понимаете свои критерии, то я могу помочь, в противном случае возитесь больше :) - person Doug Coats; 13.06.2017

arrow_upward
0
arrow_downward

Лучший способ ускорить код — не оптимизировать циклы, а изменить способ доступа к данным Excel. Всегда ссылаться на Cells намного медленнее, чем преобразовывать диапазоны в массивы и вместо этого перечислять массивы.

Подробнее здесь: Массивы и диапазоны в 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
person smartobelix    schedule 13.06.2017
comment
Я изменил свой код, чтобы запускать его как массивы, и код стал лишь немного быстрее. При выполнении он увеличился примерно на 0,2-0,3 секунды. Я делал около 1000 строк для этого примера. Есть ли способ, который имеет лучшую структуру данных и, следовательно, более устойчив к будущим изменениям? - person Ben; 13.06.2017
comment
Немного шокирован вашим комментарием. Я сделал тест на своем тестовом листе Excel с 50 тыс. строк, и сравнение времени составляет 160 мс версии массива по сравнению с 2-секундными ссылками на ячейки. Хорошо, в моих тестовых данных у меня нет дубликатов (всего несколько), но само перечисление кажется примерно в 12 раз быстрее. - person smartobelix; 14.06.2017