求A列合B列重复值时，提示，求大神修改一下！

wbjiqpl · 发表于 2018-9-14 16:27

本帖最后由 wbjiqpl 于 2018-9-15 16:32 编辑

在论坛上看到liulang0808老师的代码，意思是检查B列是否有重复值，有则提示。本人想要达到，检查A列&B列两列内容相合是否有重复值，有则提示，请大神帮忙修改一下。

表:
A列    B列
5          5
6          5
7          7
8          8

结果是 77
         88
以上数据又重复，请查阅

Private Sub Wo()
arr = Application.Intersect(ActiveSheet.UsedRange, Columns(2))
Set d = CreateObject("scripting.dictionary")
str1 = ""
For j = 1 To UBound(arr)
      If Len(arr(j, 1)) > 0 Then
         d(arr(j, 1)) = 1 + d(arr(j, 1))
         If d(arr(j, 1)) = 2 Then
            str1 = str1 & Chr(10) & arr(j, 1)
         End If
      End If
Next j
If Len(str1) > 0 Then MsgBox Mid(str1, 2) & Chr(10) & "以上数据又重复，请查阅": Cancel = True
End Sub

lsc900707 · 发表于 2018-9-14 19:50

他经常在论坛，你不可以给他留言或直接请教他？

liulang0808 · 发表于 2018-9-14 20:29

Private Sub Wo()
arr = Application.Intersect(ActiveSheet.UsedRange, Columns("A:B"))
Set d = CreateObject("scripting.dictionary")
str1 = ""
For j = 1 To UBound(arr)
      If Len(arr(j, 1) & ARR(J,2)) > 0 Then
         d(arr(j, 1)& "#" & ARR(J,2)) = 1 + d(arr(j, 1)& "#" & ARR(J,2))
         If d(arr(j, 1)& "#" & ARR(J,2)) = 2 Then
            str1 = str1 & Chr(10) & arr(j, 1) & ARR(J,2)
         End If
      End If
Next j
If Len(str1) > 0 Then MsgBox Mid(str1, 2) & Chr(10) & "以上数据又重复，请查阅": Cancel = True
End Sub
看看是否能满足需求吧

wbjiqpl · 发表于 2018-9-15 09:11

liulang0808 发表于 2018-9-14 20:29
Private Sub Wo()
arr = Application.Intersect(ActiveSheet.UsedRange, Columns("A:B"))
Set d ...

老师，昨天我也是这么改的，就是满足不了需求，麻烦你再看看。

liulang0808 · 发表于 2018-9-15 15:36

wbjiqpl 发表于 2018-9-15 09:11
老师，昨天我也是这么改的，就是满足不了需求，麻烦你再看看。

楼主方便把附加上传下吗？

wbjiqpl · 发表于 2018-9-15 16:33

liulang0808 发表于 2018-9-15 15:36
楼主方便把附加上传下吗？

老师，附件已上传在一楼，里面还有为一个文件，劳烦也帮我看一下。

wbjiqpl · 发表于 2018-9-15 18:35

liulang0808 发表于 2018-9-15 15:36
楼主方便把附加上传下吗？

另一个附件已解决

		自动登录	找回密码
密码			免费注册

[求助] 求A列合B列重复值时，提示，求大神修改一下！