[已解决]请教一个数据查找问题，谢谢

maysh2009

坛子里的大师们，请教一下

功能描述：
  将数据1中的数字在数据2中找，如果数据2中没有这数字，那么提示：数据1的XX在数据2中未找到
  将数据2中的数字在数据1中找，如果数据1中没有这数字，那么提示：数据2的XX在数据1中未找到
  如果2边的数据都能在对方找到，提示：相等。
    谢谢！




数据.zip (5.83 KB, 下载次数: 4)

2015-4-15 15:59 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2015-4-15 16:52

换个不用字典的思路，纯字符串比较

1. Sub 不用字典()
   
2.     arr = Range("a1:c" & [a65536].End(3).Row)
   
3.     For i = 2 To UBound(arr)
   
4.         s = ""
   
5.         For k = 1 To 2
   
6.             t = IIf(k = 1, 2, 1)
   
7.             x = arr(i, k)
   
8.             xrr = Split(x, ",")
   
9.             For m = 0 To UBound(xrr)
   
10.                 y = "," & xrr(m) & ","
    
11.                 If InStr("," & arr(i, t) & ",", y) = 0 Then s = s & "," & "数据" & k & "的" & xrr(m) & "在数据" & t & "未找到"
    
12.             Next
    
13.         Next
    
14.         If s = "" Then s = ",相等"
    
15.         arr(i, 3) = Mid(s, 2)
    
16.     Next
    
17.     [a7].Resize(UBound(arr), UBound(arr, 2)) = arr
    
18. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     Dim d(1 To 2) As Object
   
3.     Set d(1) = CreateObject("scripting.dictionary")
   
4.     Set d(2) = CreateObject("scripting.dictionary")
   
5.     arr = Range("a1:c" & [a65536].End(3).Row)
   
6.     For i = 2 To UBound(arr)
   
7.         For k = 1 To 2
   
8.             x = arr(i, k)
   
9.             xrr = Split(x, ",")
   
10.             For m = 0 To UBound(xrr)
    
11.                 d(k)(xrr(m)) = ""
    
12.             Next
    
13.         Next
    
14.         s = ""
    
15.         For Each xk In d(1).keys
    
16.             If Not d(2).exists(xk) Then s = s & "," & "数据1的" & xk & "在数据2未找到"
    
17.         Next
    
18.         For Each xk In d(2).keys
    
19.             If Not d(1).exists(xk) Then s = s & "," & "数据2的" & xk & "在数据1未找到"
    
20.         Next
    
21.         If s = "" Then s = ",相等"
    
22.         arr(i, 3) = Mid(s, 2)
    
23.         d(1).RemoveAll: d(2).RemoveAll
    
24.     Next
    
25.     [a7].Resize(UBound(arr), UBound(arr, 2)) = arr
    
26. End Sub
    

复制代码

grf1973

原数据里有个全角的逗号，需要改过来，不然结果有误。

grf1973

换个不用字典的思路，纯字符串比较

1. Sub 不用字典()
   
2.     arr = Range("a1:c" & [a65536].End(3).Row)
   
3.     For i = 2 To UBound(arr)
   
4.         s = ""
   
5.         For k = 1 To 2
   
6.             t = IIf(k = 1, 2, 1)
   
7.             x = arr(i, k)
   
8.             xrr = Split(x, ",")
   
9.             For m = 0 To UBound(xrr)
   
10.                 y = "," & xrr(m) & ","
    
11.                 If InStr("," & arr(i, t) & ",", y) = 0 Then s = s & "," & "数据" & k & "的" & xrr(m) & "在数据" & t & "未找到"
    
12.             Next
    
13.         Next
    
14.         If s = "" Then s = ",相等"
    
15.         arr(i, 3) = Mid(s, 2)
    
16.     Next
    
17.     [a7].Resize(UBound(arr), UBound(arr, 2)) = arr
    
18. End Sub

复制代码

maysh2009

grf1973 发表于 2015-4-15 16:52
换个不用字典的思路，纯字符串比较

谢谢，我刚使用split分开，放入数组里面，这样的话，就会出现一个问题，
比如： 源数据1的 27，数据2的527，这样就检测不出来了

maysh2009

grf1973 发表于 2015-4-15 16:52
换个不用字典的思路，纯字符串比较

使用前后加一个 “，”的方式完美解决，您的这个办法实用，谢谢指导

白开水的微笑

maysh2009 发表于 2015-4-15 17:05
谢谢，我刚使用split分开，放入数组里面，这样的话，就会出现一个问题，
比如： 源数据1的 27，数据2的5 ...

需要改写，比如原数据为1，2，3，22    需要将其改为，1，2，3，22，

Split之后的元素需要在两边加逗号",1,"  ",2,"  ",3,"   ",22,"
这样就能精确比较了

maysh2009

白开水的微笑 发表于 2015-4-15 17:28
需要改写，比如原数据为1，2，3，22    需要将其改为，1，2，3，22，

Split之后的元素需要在两边加逗号 ...

嗯嗯，我看到前面的回复，然后 照着这样的思路就成了，谢谢你们