Sub test()
Rem MsgBox ("AAAAA")
Dim pos, pos1, tmp, total1, total2, tmpStr, tmpStr1, col, sheetR
sheetR = 2
Rem 获取Sheet1的行数
total1 = Sheet1.UsedRange.Rows.Count
Rem 获取Sheet1的列数,后面把不满足的条目复制到Sheet3中
col = Sheet1.UsedRange.Columns.Count
Rem 获取Sheet2的行数
total2 = Sheet2.UsedRange.Rows.Count
MsgBox "sheet1 行: " & total1 & " sheet2 行:" & total2 & " " & col
Rem 开始循环,第一个循环是遍历Sheet1中第六列的所有行数据,从2到total1
For pos = 2 To Sheet1.UsedRange.Rows.Count
tmpStr = Sheet1.Cells(pos, 6)
Sheet1.Cells(pos, 6).Interior.ColorIndex = 2
Rem MsgBox "***********sheet1*********** Row :" & pos & " data :" & tmpStr
Rem 在Sheet2的指定列(这里第4列)的所有行数据中查找
For pos1 = 2 To Sheet2.UsedRange.Rows.Count
tmpStr1 = Sheet2.Cells(pos1, 4)
tmp = Sheet2.Cells(pos1, 5)
Rem 找到指定数据,sheet2中的第5列是辅助查找结果的,sheet1中是第7列。
If tmpStr = tmpStr1 Then
Rem 在Sheet2中找到了,首先查看Sheet2中的辅助列是不是填了值,填了值说明以前sheet1中的数据在Sheet2中匹配过,这个就不能用,要继续查找
If Sheet2.Cells(pos1, 5) = "" Then
Rem MsgBox "########sheet2######## NULL :" & Sheet2.Cells(pos1, 5) & " Row : " & pos1
Rem Sheet2中的辅助列保存Sheet1 数据的行号
Sheet2.Cells(pos1, 5) = "Row" & pos
Rem Sheet1中的辅助列保存Sheet2 数据的行号
Sheet1.Cells(pos, 7) = "Row" & pos1
Rem MsgBox "########sheet2########" & tmpStr1 & " sheet1 : " & pos & " sheet2 : " & pos1
Exit For
Else
Rem MsgBox "########sheet2######## not NULL :" & Sheet2.Cells(pos1, 5) & " Row : " & pos1
End If
End If
Next
If pos1 >= total2 Then
Rem MsgBox "can't find " & tmpStr & " in sheet2 " & " Row : " & pos1
Rem 将Sheet1中没找到的数据设置成红色
Sheet1.Cells(pos, 6).Interior.ColorIndex = 3
Dim i
For i = 1 To col
Rem 将Sheet1中没找到的数据行复制到Sheet3
Sheet3.Cells(sheetR, i) = Sheet1.Cells(pos, i)
Next
sheetR = sheetR + 1
End If
Next
MsgBox ("Done!!!")
End Sub
Rem开头的是注释
Sheet3中保存的数据就是未匹配的项,以Sheet1中的某一列数据为匹配对象在Sheet2中查找