Excel宏 - 比較2行並複製副本

-2

是否可以通過宏運行來查找第1頁和第2頁中的重複信息，然後將其複製到第3個？Excel宏 - 比較2行並複製副本

例如..搜索在表1 - A1到數據的底部如果發現重複然後該行復制到表3與表2 A1到數據

的底部比較這？

然後循環呢？

我看了一下，但沒有任何工作，如果數據是隨機的順序。

來源

2014-02-19 Jacko058

'我已經環顧四周，但沒有什麼工作，如果數據是隨機order.' -show我們的嘗試，請在這裏 –

@simoco是一個我發現，但它不起作用。它只複製標題。 http://stackoverflow.com/questions/19320017/in-excel-how-to-compare-a-columns-in-2-sheets-and-copy-matching-rows-to-sheet3 – Jacko058

你試過修改這個代碼來滿足您的需求？ –

dim i as integer 
dim j as integer 
dim counter as integer 
dim flagMatch as boolean 

counter = 1 

for i = 1 to 'number of rows in sheet1 
    flagMatch = false 
    for j = 1 to 'number of row in sheet2 
     if sheet1.cells(i, 1) = sheet2.cells(j, 1) then 
      flagMatch = true 
     end if 
    next j 
next i 
if flagMatch = true then 
    sheet3.cells(counter, 1) = sheet1.cells(i, 1) 
    counter = counter + 1 
end if

來源

2014-02-19 09:14:33 Pedrumj

你可以試試這個：

Sub CopyDuplicates() 
Dim w1, w2, w3, ws, v, p 
Dim r1 As Long, r3 As Long, nr As Long 
Set w1 = Sheets(1) 
Set w2 = Sheets(2) 
Set w3 = Sheets(3) 
r1 = 1 
r3 = 1 
On Error GoTo TheEnd 
Application.ScreenUpdating = False 
nr = w2.Cells(1, 1).End(xlDown).Row 
Set ws = w2.Range(w2.Cells(1, 1), w2.Cells(nr, 1)) 
Do While Not IsEmpty(w1.Cells(r1, 1)) 
v = w1.Cells(r1, 1) 
p = Application.Match(v, ws, 0) 
If Not IsError(p) Then 
    w1.Rows(r1).Copy Destination:=w3.Rows(r3) 
    r3 = r3 + 1 
End If 
r1 = r1 + 1 
Loop 
TheEnd: 
Application.ScreenUpdating = True 
End Sub

來源

2014-02-19 12:01:38 CRondao

Excel宏 - 比較2行並複製副本

回答

相關問題