首页 文章

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

提问于
浏览
0

目标:

  • 搜索并比较两个字段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大师 .

1 回答

  • 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代码对其进行着色 .

相关问题