[已解决]自动判断两列之间数据是否匹配

labrookie

老师好，我想将当前的宏修改成用户在“装盒的打标号”里一录入数据就运行宏，判断他们数据是否录入正确。另外一个问题是“错误标号”能否直接显示“不一致”在错误行的旁边并标红，不将其筛选在错误标号列里头。如图示。

模板new.zip (28.05 KB, 下载次数: 8)

2015-11-8 11:08 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2015-11-9 10:28

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Column <> 3 Then Exit Sub
   
3.     If Target.Count > 1 Then Exit Sub
   
4.     r = Target.Row
   
5.     If r = 1 Then Exit Sub
   
6.     arr = Range("b1:b" & [B65536].End(xlUp).Row)
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     For i = 2 To UBound(arr)
   
9.         If Len(arr(i, 1)) Then d(arr(i, 1)) = ""
   
10.     Next
    
11.     x = Target.Value
    
12.     If Len(x) = 0 Or d.exists(x) Then
    
13.         Cells(r, 1).Resize(1, 4).Interior.ColorIndex = 0
    
14.         Cells(r, 4) = ""
    
15.     Else
    
16.         Union(Target.Offset(, -2), Target.Offset(, 1)).Interior.ColorIndex = 3
    
17.         Cells(r, 4) = "不一致"
    
18.     End If
    
19. End Sub

复制代码

跳转到最佳答案楼层

qh8600

既然都写代码了，逻辑还那么混乱啊

labrookie

qh8600 发表于 2015-11-8 12:36
既然都写代码了，逻辑还那么混乱啊

......

labrookie

不是吧，论坛没有人？

grf1973

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Column <> 3 Then Exit Sub
   
3.     If Target.Count > 1 Then Exit Sub
   
4.     r = Target.Row
   
5.     If r = 1 Then Exit Sub
   
6.     arr = Range("b1:b" & [B65536].End(xlUp).Row)
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     For i = 2 To UBound(arr)
   
9.         If Len(arr(i, 1)) Then d(arr(i, 1)) = ""
   
10.     Next
    
11.     x = Target.Value
    
12.     If Len(x) = 0 Or d.exists(x) Then
    
13.         Cells(r, 1).Resize(1, 4).Interior.ColorIndex = 0
    
14.         Cells(r, 4) = ""
    
15.     Else
    
16.         Union(Target.Offset(, -2), Target.Offset(, 1)).Interior.ColorIndex = 3
    
17.         Cells(r, 4) = "不一致"
    
18.     End If
    
19. End Sub

复制代码

grf1973

请看附件。按钮的代码也重写了一下，供检查用。

labrookie

grf1973 发表于 2015-11-9 10:28

老师，你好，如果我不是手动录入，而是大批量复制黏贴进来，它需要点一个个单元格才生效，有没有办法做到复制黏贴上去也能自动激活change事件