Question

目标：

搜索＆amp;比较两个字段列E（表2）到列E（表1）将表2中的重复值返回到表3
显示并突出显示重复项突出显示工作表1和2上的值
从工作表2复制重复的条目，然后添加到工作表3

如果E列（表2）= E列（表1），则从（表2）复制行并添加到表3

我正在尝试比较工作簿中的两个Excel工作表。我想在工作表2和1之间找到重复的值，并在两个工作表上突出显示这些值。我知道这是一个匹配或vlookup函数，但添加的图层是我想将这些值仅从第2页复制到第3页进行视觉比较。我试图创建一个宏，但这没有帮助，我正在尝试编辑它;

Sub rowContent()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long, j As Long
    Dim isMatch As Boolean
    Dim newSheetPos As Integer

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

'Initial position of first element in sheet2
newSheetPos = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

For i = 1 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    isMatch = False
    For j = 1 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
        If ws1.Cells(i, 1).Value = ws1.Cells(j, 2).Value Then
            ws1.Cells(j, 2).EntireRow.Copy ws2.Cells(newSheetPos, 1)
            isMatch = True
            newSheetPos = newSheetPos + 1
        End If
    Next j
    If isMatch = False Then newSheetPos = newSheetPos + 1
Next i
End Sub

为我的情况工作。任何帮助将不胜感激，因为我不是Excel大师。

Answer 1

您可以尝试这样的事情......

Sub CopyDuplicates()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim lr1 As Long, lr2 As Long, lc1 As Long, lc2 As Long, r As Long
Dim rng As Range, cell As Range
Application.ScreenUpdating = False

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")

ws3.Cells.Clear
lr2 = ws2.UsedRange.Rows.Count
lc1 = ws1.UsedRange.Columns.Count
lc2 = ws2.UsedRange.Columns.Count

ws1.UsedRange.Interior.ColorIndex = xlNone
ws2.UsedRange.Interior.ColorIndex = xlNone

Set rng = ws2.Range("E1:E" & lr2)
For Each cell In rng
    If Application.CountIf(ws1.Range("E:E"), cell.Value) > 0 Then
        r = Application.Match(cell.Value, ws1.Range("E:E"), 0)
        ws1.Range(ws1.Cells(r, 1), ws1.Cells(r, lc1)).Interior.Color = vbRed
        ws2.Range(ws2.Cells(r, 1), ws2.Cells(r, lc2)).Interior.Color = vbRed
        cell.EntireRow.Copy ws3.Range("A" & Rows.Count).End(3)(2)
    End If
Next cell
ws3.Rows(1).Delete
Application.ScreenUpdating = True
End Sub

上面的代码假设您在工作簿中有三张Sheet1，Sheet2和Sheet3。

代码将删除Sheet1和Sheet2上任何现有的单元格内部颜色，然后突出显示红色的重复行。

如果您对这些工作表应用了一些颜色格式，最好使用条件格式来突出显示带有重复项的行，而不是通过VBA代码对它们进行着色。

比较两个Excel表格并提取重复数据

1 个答案: