vba Excel - 用于比较多行然后复制到不同工作表的宏
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5573632/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel - Macro to compare multiple rows then copy to different worksheet
提问by elf
I am trying to figure out a Macro to copy a row of data to a new worksheet once my conditions are meet. I found another question answer but it is too different for me to figure it out: Other Answer
我正在尝试找出一个宏，以便在满足条件后将一行数据复制到新工作表中。我找到了另一个问题答案，但对我来说太不同了，无法弄清楚：其他答案
What I have is a 30000+ row and BB columns of data. I want to compare data in one column from row to row and when I find the sequence I want copy the last row in the sequence to a different worksheet. Sample Data:
我拥有的是 30000+ 行和 BB 列的数据。我想逐行比较一列中的数据，当我找到序列时，我想将序列中的最后一行复制到不同的工作表。样本数据：
Numbers - Other Data - Other Data...
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
数字 - 其他数据 - 其他数据...
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
In this case, I would want to find the sequence of three ones and copy the row with yyy data into a new worksheet. Your help is appreciated.
在这种情况下，我想找到三个的序列并将带有 yyy 数据的行复制到一个新工作表中。感谢您的帮助。
回答by Excellll
Try this:
尝试这个：
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
