vba,从sheet1某单元格的数据，在sheet2中的b列和d列搜索重复项

vba,从sheet1某单元格的数据，在sheet2中的b列和d列搜索重复项

工作表事件代码
alt+F11
左边工程框双击sheet1
将代码复制到右边空白区

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$J$3" Then Exit Sub
If Application.WorksheetFunction.CountIf(Sheets("sheet2").Range("B:D"), Target) = 0 Then
MsgBox "未找到"
Else
For Each rng In Sheets("sheet2").Range("B:D")
If rng = Target Then
MsgBox "案号为 " & rng.Offset(, -1).Value
End If
Next
End If

End Sub

呵呵 ，这个你可以先录个宏然后自己修改一下，应该不是很难做到，都是EXCEL的基本操作，VBA很容易就可以实现的，另外你你可以将你的问题完善一下，最后有原始数据的那种，不然的话测试数据都没有啊

'下述代码的功能是如果B列有重复项则提示是否继续，是则继续运行
'B列找完后再找D列，D列如果有重复项则同样出现提示
'如果在出现提示后按“否”，则程序立即退出
Sub 按钮1_单击()
Dim i As Integer, j As Integer, n As Integer, u As Integer
n = 1000 '假定数据在2-1000行
For i = 2 To n Step 1
If Sheet2.Cells(i, 2) = "" Then Exit For
For j = 1 To n - i Step 1
If Sheet2.Cells(i, 2) = Sheet2.Cells(i + j, 2) Then
Sheet1.Cells(3, 10) = Sheet2.Cells(i, 1)
u = MsgBox("在B列找到重复项" & Chr(10) & "是否继续", vbYesNo + vbQuestion)
If u = 7 Then Exit Sub
End If
Next j
Next i
For i = 2 To n Step 1
If Sheet2.Cells(i, 2) = "" Then Exit For
For j = 1 To n - i Step 1
If Sheet2.Cells(i, 4) = Sheet2.Cells(i + j, 4) Then
Sheet1.Cells(3, 10) = Sheet2.Cells(i, 3)
u = MsgBox("在D列找到重复项" & Chr(10) & "是否继续", vbYesNo + vbQuestion)
If u = 7 Then Exit Sub
End If
Next j
Next i
End Sub