[已解决]数据逐一比较问题（请老师给予函数）

kandhong · 发表于 2015-1-13 11:06

本帖最后由 kandhong 于 2015-1-13 11:19 编辑

老师：
   我请教的是：数据逐一比较问题。
   具体思路如下：
   ①K列、L列有数据
   020508等同于2 5 8
   010211等同于1 2 11
   ②想要实现的效果：
   以L18为例，依次让L18和K18、K17、K16、K15、K14至K4进行比较。
   如果他们含有1个或2个或3个相同的数字时用“1”表示，否则用“2”表示。
   其结果依次填入到M18、NM18、OM18、PM18、QM18至AA18。
   谢谢老师！！

数据逐一比较问题.rar (7.36 KB, 下载次数: 13)

芐雨 · 发表于 2015-1-13 12:09

函数不好做，用VBA吧

数据逐一比较问题.zip (15.72 KB, 下载次数: 17)

hsl215 · 发表于 2015-1-13 12:44

请看附件函数做法,
有一个问题要确认一下,
091112与090112用11对比全部算1还是091112为1,090112为2?

数据逐一比较问题.rar (7.8 KB, 下载次数: 6)

kandhong · 发表于 2015-1-13 13:39

hsl215 发表于 2015-1-13 12:44
请看附件函数做法,
有一个问题要确认一下,
091112与090112用11对比全部算1还是091112为1,090112为2?

hsl215 老师：
   您的vba已收悉，K列和L列数据均由三位数组成，且由小到大排列。
   例如：010203表示1和2和 3；
               091112表示9和11和12

kandhong · 发表于 2015-1-13 13:49

芐雨发表于 2015-1-13 12:09
函数不好做，用VBA吧

芐雨老师：
   您的VBA已收悉，效果非常好！！
   此外，还有一事请教：能否让L列每位数都和K列所有数进行比对，然后把结果显示出来！！
   举例如下：L18和K4:K18所有数进行比较，然后将显示结果在L18后面显示出来；
                     L17和K4:K18所有数进行比较，然后将显示结果在L17后面显示出来;
                     L16和K4:K18所有数进行比较，然后将显示结果在L16后面显示出来;
                     以下规则相同
   芐雨老师，期待您的回复！！

芐雨 · 发表于 2015-1-13 14:16

kandhong 发表于 2015-1-13 13:49
芐雨老师：
您的VBA已收悉，效果非常好！！
此外，还有一事请教：能否让L列每位数都和K列所 ...

修改一下里面的代码即可，还有对比的顺序是从上而下

Sub t()
Dim arr, brr, crr, i&, j&, x%
arr = Range("K4:L" & Cells(Rows.Count, "K").End(3).Row)
ReDim brr(0 To 99)
ReDim crr(1 To UBound(arr), 1 To UBound(arr))
For i = 1 To UBound(arr)
brr(Val(Mid(arr(i, 2), 1, 2))) = 1
brr(Val(Mid(arr(i, 2), 3, 2))) = 1
brr(Val(Mid(arr(i, 2), 5, 2))) = 1
For j = 1 To UBound(arr)
For x = 1 To 6 Step 2
If brr(Val(Mid(arr(j, 1), x, 2))) = 1 Then
crr(i, j) = 1
Exit For
Else
crr(i, j) = 2
End If
Next
Next
ReDim brr(0 To 99)
Next
Range("M4").Resize(UBound(arr), UBound(arr)) = crr
End Sub

复制代码

kandhong · 发表于 2015-1-13 16:31

芐雨发表于 2015-1-13 14:16
修改一下里面的代码即可，还有对比的顺序是从上而下

芐雨老师：
   您的VBA已收悉，效果和我的思路有些出处。
   我想要的效果是：
   以L18为例，让L18和K18、K17、K16、K15、K14一直至K4依次进行比较。
   L18和K4:K18所有数进行比较，然后将显示结果在L18后面显示出来；
   L17和K4:K18所有数进行比较，然后将显示结果在L17后面显示出来;
   L16和K4:K18所有数进行比较，然后将显示结果在L16后面显示出来。

   谢谢老师！！

数据逐一比较问题.rar (13.48 KB, 下载次数: 1)

kandhong · 发表于 2015-1-13 16:57

hsl215 发表于 2015-1-13 12:44
请看附件函数做法,
有一个问题要确认一下,
091112与090112用11对比全部算1还是091112为1,090112为2?

hsl215老师：
   您的函数已收悉，在使用的过程中发现：
   公式向上拉动时，出现错误。如图所示：

hsl215 · 发表于 2015-1-13 19:16

kandhong 发表于 2015-1-13 16:57
hsl215老师：
您的函数已收悉，在使用的过程中发现：
公式向上拉动时，出现错误。如图所示 ...

看看附件是否可以，怎么和你的图片中的数据有点差异

数据逐一比较问题.rar (76.05 KB, 下载次数: 14)

芐雨 · 发表于 2015-1-13 19:59

刚刚对比是从上到下来对比，现在是从下到上

Sub 对比()
Dim arr, brr, crr, i&, j&, x%
arr = Range("K4:L" & Cells(Rows.Count, "K").End(3).Row)
ReDim brr(0 To 99)
ReDim crr(1 To UBound(arr), 1 To UBound(arr))
For i = UBound(arr) To 1 Step -1
brr(Val(Mid(arr(i, 2), 1, 2))) = 1
brr(Val(Mid(arr(i, 2), 3, 2))) = 1
brr(Val(Mid(arr(i, 2), 5, 2))) = 1
For j = UBound(arr) To 1 Step -1
For x = 1 To 6 Step 2
If brr(Val(Mid(arr(j, 1), x, 2))) = 1 Then
crr(i, UBound(arr) - j + 1) = 1
Exit For
Else
crr(i, UBound(arr) - j + 1) = 2
End If
Next
Next
ReDim brr(0 To 99)
Next
Range("m4").Resize(UBound(arr), UBound(arr)) = crr
End Sub

复制代码

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

[已解决]数据逐一比较问题（请老师给予函数）

评分