2011-04-06 74 views
0

我試圖找出一個宏,一旦我的條件滿足,將一行數據複製到新的工作表。我發現了另一個問題的答案,但它對我來說太不同了:Other AnswerExcel - 宏來比較多個行,然後複製到不同的工作表

我所擁有的是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

在這種情況下,我想找到三個1的序列並將包含yyy數據的行復制到新的工作表中。感謝您的幫助。

回答

0

試試這個:

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 
相關問題