求教VBA比较2个excel的问题

sdytsxd991122

将文件1的c列f列装入字典，把文件2赋值数据组，循环数据组，判断是否在字典中 在写在sheet1，不在写sheet2中

Lovertdos

这个好简单

Lovertdos

Private Sub CommandButton1_Click()
    Dim file1 As Variant
    Dim file2 As Variant
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim ws4 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim j As Long
    Dim found As Boolean
   
    ' 选择文件1
    file1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
    If file1 = False Then Exit Sub
   
    ' 选择文件2
    file2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
    If file2 = False Then Exit Sub
   
    ' 打开文件1和文件2
    Set wb1 = Workbooks.Open(file1)
    Set wb2 = Workbooks.Open(file2)
   
    ' 获取文件1和文件2的工作表
    Set ws1 = wb1.Sheets(1)
    Set ws2 = wb2.Sheets(1)
   
    ' 创建Sheet1和Sheet2
    Set ws3 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws3.Name = "Sheet1"
    Set ws4 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws4.Name = "Sheet2"
   
    ' 获取文件1和文件2的最后一行
    lastRow1 = ws1.Cells(ws1.Rows.Count, "C").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row
   
    ' 遍历文件1的数据
    For i = 2 To lastRow1
        found = False
        
        ' 遍历文件2的数据
        For j = 2 To lastRow2
            ' 对比C列和D列
            If ws1.Cells(i, "C").Value = ws2.Cells(j, "D").Value And ws1.Cells(i, "F").Value = ws2.Cells(j, "G").Value Then
                ' 将匹配到的数据复制到Sheet1
                ws2.Rows(j).Copy ws3.Cells(ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row + 1, 1)
                found = True
                Exit For
            End If
        Next j
        
        ' 如果在文件2中找不到匹配的数据，将该行复制到Sheet2
        If Not found Then
            ws1.Rows(i).Copy ws4.Cells(ws4.Cells(ws4.Rows.Count, "A").End(xlUp).Row + 1, 1)
        End If
    Next i
   
    ' 关闭文件1和文件2
    wb1.Close SaveChanges:=False
    wb2.Close SaveChanges:=False
   
    MsgBox "对比完成！"
End Sub


AI写的

fanyoulin

做是做了，但怎么没有比对成功的记录呢？

你要自己判断，我看不出来；

xiaoxiao79

谢谢 Lovertdos

xiaoxiao79

谢谢 fanyoulin