Excel - 比较多行然后复制到不同工作表的宏答案

【问题标题】：Excel - Macro to compare multiple rows then copy to different worksheetExcel - 比较多行然后复制到不同工作表的宏
【发布时间】：2011-07-31 05:25:31
【问题描述】：

我正在尝试找出一个宏，以便在满足我的条件后将一行数据复制到新工作表中。我找到了另一个问题的答案，但它对我来说太不同了：Other Answer

我拥有的是 30000+ 行和 BB 列的数据。我想逐行比较一列中的数据，当我找到序列时，我想将序列中的最后一行复制到不同的工作表中。样本数据：

数字 - 其他数据 - 其他数据...
1 - xxx - xxx
0 - xxx - xxx
1 - xxx - xxx
1 - xxx - xxx
0 - xxx - xxx
1 - xxx - xxx
1 - xxx - xxx
1 - 年年 - 年年
0 - xxx - xxx

在这种情况下，我想找到三个 1 的序列并将包含 yyy 数据的行复制到一个新的工作表中。感谢您的帮助。

【问题讨论】：

标签： excel vbscript vba

【解决方案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

【讨论】：