Excel – макрос для сравнения нескольких строк, затем копирование на другой рабочий лист

Вопрос:

Я пытаюсь вычислить макрос, чтобы скопировать ряд данных на новый рабочий лист после удовлетворения моих условий. Я нашел другой ответ на вопрос, но для меня это совсем другое: Другой ответ

У меня есть столбцы данных в столбцах 30000+ и BB. Я хочу сравнить данные в одном столбце от строки к строке, и когда я найду последовательность, я хочу скопировать последнюю строку в последовательности на другой рабочий лист. Пример данных:

Числа – другие данные – другие данные…
1 – xxx – xxx
0 – xxx – xxx
1 – xxx – xxx
1 – xxx – xxx
0 – xxx – xxx
1 – xxx – xxx
1 – xxx – xxx
1 – yyy – yyy
0 – xxx – xxx

В этом случае я хотел бы найти последовательность из трех и скопировать строку с данными yyy в новый рабочий лист. Ваша помощь приветствуется.

Ответ №1

Попробуйте следующее:

Sub thirdmatch()

Dim arrKey() As Variant
Dim arrOut() As Variant
Dim rowCnt As Integer
Dim rr As Integer
Dim rOut As Integer
Dim i As Integer

Dim s1 As Worksheet
Dim s2 As Worksheet
Dim r1 As Range
Dim r2 As Range

Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set r1 = s1.Range("A2", s1.Range("A4"))
Set r2 = s2.Range("A2")

rowCnt = s1.Range("A1", s1.Range("A1").End(xlDown)).Count
rr = 0
rOut = 0

Do While rr < rowCnt
arrKey = r1.Offset(rr, 0)
If arrKey(1, 1) = arrKey(2, 1) And arrKey(2, 1) = arrKey(3, 1) And arrKey(1, 1) = 1 Then
arrOut = s1.Range("A" & rr + 4, s1.Range("BB" & rr + 4))
For i = 1 To 54
r2.Offset(rOut, i - 1) = arrOut(1, i)
Next i
rOut = rOut + 1
End If
rr = rr + 1
Loop

End Sub