在excel中，用VBA实现两列数据的比较

Posted 2023-03-18

如果我在A列中，输入的数据与B列中已有的数据有重复，那么A列中我输入的那个数据就变成红色，否则不变色，用VBA实现
qgrmdtj好象有些问题

实现代码如下：

1234567891011121314151617Sub abc() Dim D As Object, i As Integer, index As Integer Set D = CreateObject("scripting.dictionary") With Sheet1 For i = 1 To Range("b65536").End(xlUp).Row D(.Cells(i, 2).Value) = "" Next For i = 1 To Range("a65536").End(xlUp).Row If Not D.Exists(.Cells(i, 1).Value) Then index = index + 1 .Cells(index, 3) = .Cells(i, 1) End If Next End WithEnd Sub
用字典比较方便，省去重复的循环过程
如果数据量大，双层循环效率是很低的。 参考技术A 正面这段程序是反复测试过的，你粘贴到你的工作表的VBA中去就行了。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Target.Column = 1 Then
If Application.WorksheetFunction.CountIf(Range("B:B"), Target) >= 1 Then
Target.Interior.ColorIndex = 3
Else
Target.Interior.ColorIndex = -4142
End If
End If
End If
End Sub 参考技术B 用我这个试试

那就加一句

Private Sub Worksheet_Change(ByVal my As Range)
On Error Resume Next
With Application.WorksheetFunction
If my.Column = 1 Then
For Each rng In Range([a2], [a65536].End(xlUp))
If rng <> "" And .CountIf(Range([b2], [b65536].End(xlUp)), rng) > 0 Then
rng.Font.ColorIndex = 3
End If
Next
End If
End With
End Sub
------------------------------------------

那就加一句

Private Sub Worksheet_Change(ByVal my As Range)
On Error Resume Next
With Application.WorksheetFunction
If my.Column = 1 Then
For Each rng In Range([a2], [a65536].End(xlUp))
If rng <> "" And .CountIf(Range([b2], [b65536].End(xlUp)), rng) > 0 Then
rng.Font.ColorIndex = 3
Else
rng.Font.ColorIndex = 1
End If
Next
End If
End With
End Sub本回答被提问者采纳 参考技术C Private Sub Worksheet_Change(ByVal Target As Range)
Target.Font.ColorIndex = 0
Dim i As Integer
If Target.Column = 1 Then
For i = 1 To Range("b65536").End(xlUp).Row
If Target = Cells(i, 2) Then
Target.Font.ColorIndex = 3
Exit Sub
End If
Next
End If
End Sub 参考技术D Private Sub Worksheet_Change(ByVal Target As Range)
Target.Font.ColorIndex = 0
If Target.Column = 1 And Target = Target.Offset(0, 1) Then
Target.Font.ColorIndex = 3
End If
End Sub

excel vba数据比较？

如图，sheet1和sheet2中分别有两列数据，需要把sheet1中第一列的每个数据去sheet2中第1列中查找，找到相同的数据时，比较对应的第2列数据，第二列数据不同时在sheet1第3列中注明。

申明，我也才只学了几天，仅供参考- -所学不多，所以代码写的丑陋，练练手而已

在sheet1中插入代码：

---

Sub ZBT()

Dim i%, j%

    [c:c].Clear

For i = 2 To Range("a99999").End(3).Row

    j = Application.WorksheetFunction.CountIf(Worksheets("sheet2").[a:a], Cells(i, 1))

    If j = 0 Then

        Cells(i, 3) = "查无此序号"

    ElseIf j > 1 Then

        Cells(i, 3) = "有多项结果"

    ElseIf Cells(i, 2) <> Application.WorksheetFunction.VLookup(Cells(i, 1), Worksheets("sheet2").[a:b], 2, 0) Then

        Cells(i, 3) = "不同"

    End If

Next i

End Sub

参考技术A 一个公式就解决了，用不着Vba吧。c2=if(isblank(a2),"",iferror(if(vlookup(a2,sheet2!a:b,2,0)=b2,"","不相同"),"没得记录"))，公式下拉自动填充即可。追问

感谢回复，数据比较多，想要学习学习vba能不能快速处理