Question

是否可以通过宏运行从第1页和第2页查找重复信息，然后将其复制到第三个？

例如..搜索工作表1 - A1到数据底部将此与Sheet 2 A1与数据底部进行比较

如果找到重复项，则将该行复制到Sheet 3？

然后循环呢？

我已经浏览了一下，但如果数据是随机顺序则无效。

Answer 1

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

Answer 2

你可以试试这个：

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

Excel宏 - 比较2行并复制副本

2 个答案: