Excel - Макрос для сравнения нескольких строк, а затем копирования на другой лист - PullRequest
Новая
       14

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

0 голосов
/ 07 апреля 2011

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

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

Числа - Прочие данные - Прочие данные ...
1 - ххх - ххх
0 - ххх - ххх
1 - ххх - ххх
1 - ххх - ххх
0 - ххх - ххх
1 - ххх - ххх
1 - ххх - ххх
1 - гггг - ггг
0 - ххх - ххх

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

1 Ответ

0 голосов
/ 07 апреля 2011

Попробуйте это: 

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
...