Excel如何实现两个工作表数据的对比

https://jingyan.baidu.com/article/63f236281f17650208ab3d97.html

Sub 数据对比()

Dim i As Integer

Dim j As Integer

For i = 2 To 3225 '员工基础报表数据范围

For j = 2 To 2028 '员工待遇统计表数据范围

If Sheets("old").Cells(i, 6) = Sheets("new").Cells(j, 6) Then

Sheets("old").Cells(i, 8) = "已存在" '存在时进行标记

End If

Next j

Next i

End Sub

前面插入一列"Index"序号

Sub 数据对比()

Dim i As Integer

Dim j As Integer

For i = 2 To 3225 '员工基础报表数据范围

For j = 2 To 2028 '员工待遇统计表数据范围

If Sheets("old").Cells(i, 7) = Sheets("new").Cells(j, 7) Then

Sheets("old").Cells(i, 11) = "已存在" '存在时进行标记

Sheets("new").Cells(j, 11) = "源表已存在" '存在时进行标记

Sheets("old").Cells(i, 12) = i

Sheets("new").Cells(j, 12) = i

End If

Next j

Next i

End Sub

双重过滤，才能精准

Sub 数据对比()

Dim i As Integer

Dim j As Integer

For i = 2 To 3225 '员工基础报表数据范围

For j = 2 To 2028 '员工待遇统计表数据范围

If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

If Sheets("old").Cells(i, 7) = Sheets("new").Cells(j, 7) Then

Sheets("old").Cells(i, 11) = "已存在" '存在时进行标记

Sheets("new").Cells(j, 11) = "源表已存在" '存在时进行标记

Sheets("old").Cells(i, 12) = i

Sheets("new").Cells(j, 12) = i

End If

End If

Next j

Next i

End Sub

成功匹配：

Sub 数据对比()

Dim i As Integer

Dim j As Integer

For i = 2 To 3225 '员工基础报表数据范围

For j = 2 To 2028 '员工待遇统计表数据范围

If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

If Sheets("old").Cells(i, 7) = Sheets("new").Cells(j, 7) Then

Sheets("old").Cells(i, 11) = "已存在" '存在时进行标记

Sheets("new").Cells(j, 11) = "源表已存在" '存在时进行标记

Sheets("old").Cells(i, 12) = i

Sheets("new").Cells(j, 12) = i

End If

End If

Next j

Next i

End Sub

数值填充(大小写、双引号不能模糊匹配，需要改善)

Sub 数据对比()

Dim i As Integer

Dim j As Integer

For i = 2 To 1362 '源表

For j = 2 To 1182 'overlay表

'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

If Sheets("old").Cells(i, 1) = Sheets("new").Cells(j, 1) Then

Sheets("old").Cells(i, 2) = Sheets("new").Cells(j, 2).Value '存在时进行标记

End If

'End If

Next j

Next i

End Sub

改善后代码：

Option Compare Text

Sub 数据对比()

Dim i As Integer

Dim j As Integer

For i = 2 To 1364 '源表

For j = 2 To 1183 'overlay表

'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

If StrComp(Sheets("old").Cells(i, 1).Value, Sheets("new").Cells(j, 1).Value, 1) = 0 Then

Sheets("old").Cells(i, 2) = Sheets("new").Cells(j, 2).Value '存在时进行标记

End If

'End If

Next j

Next i

End Sub

或添加"Trim"函数过滤外侧空格

Option Compare Text

Sub 数据对比()

Dim i As Integer

Dim j As Integer

For i = 2 To 1364 '源表

For j = 2 To 1183 'overlay表

'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

If StrComp(Trim(Sheets("old").Cells(i, 1).Value), Trim(Sheets("new").Cells(j, 1).Value), 1) = 0 Then

Sheets("old").Cells(i, 2) = Sheets("new").Cells(j, 2).Value '存在时进行标记

End If

'End If

Next j

Next i

End Sub

再次改善代码，自动获取最后一行的长度

Option Compare Text

Sub 数据对比()

Dim sLength As Integer '记录源表长度

Dim dLength As Integer '记录目标表长度

Dim i As Integer

Dim j As Integer

sLength = Sheets("old").Cells(Rows.Count, "A").End(xlUp).Row

dLength = Sheets("new").Cells(Rows.Count, "A").End(xlUp).Row

Debug.Print "source sheet length:" & sLength

Debug.Print "dir sheet length:" & dLength

For i = 2 To sLength

For j = 2 To dLength

'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

If StrComp(Trim(Sheets("old").Cells(i, 1).Value), Trim(Sheets("new").Cells(j, 1).Value), 1) = 0 Then

Sheets("old").Cells(i, 2) = Sheets("new").Cells(j, 2).Value '存在时进行标记

End If

'End If

Next j

Next i

End Sub

再次改善：声明工作表引用类型

Option Explicit

Option Compare Text

Sub 数据匹配导入()

'声明语句

Dim i As Integer

Dim j As Integer

Dim sLength As Integer '源工作表长度

Dim dLength As Integer '目标工作表长度

Dim sSheet As Sheet1 '源工作表

Dim dSheet As Sheet2 '目标工作表

'赋值语句

'Set sSheet = Sheets("old") 'old是源工作表的名称

'Set dSheet = Sheets("new") 'new是目标工作表的名称

Set sSheet = Sheets(1) '第一个工作表

Set dSheet = Sheets(2) '第二个工作表

'获取工作表总列数

sLength = sSheet.Cells(Rows.Count, "A").End(xlUp).Row

dLength = dSheet.Cells(Rows.Count, "A").End(xlUp).Row

'打印总列数

Debug.Print "source sheet length:" & sLength

Debug.Print "dir sheet length:" & dLength

Application.ScreenUpdating = False '关闭屏幕更新

For i = 2 To sLength '第一行是标题行

For j = 2 To dLength

If StrComp(Trim(sSheet.Cells(i, 1).Value), Trim(dSheet.Cells(j, 1).Value), 1) = 0 Then

sSheet.Cells(i, 2) = dSheet.Cells(j, 2).Value '将目标工作表的第二列赋值到源工作表的第二列

End If

Next j

Next i

Application.ScreenUpdating = True '重新开启屏幕更新

'数据匹配完成后弹出提醒

MsgBox "匹配完成！"

End Sub

好文推荐