[已解决]求助：VBA一一对应的问题，谢谢

maysh2009 · 发表于 2012-3-19 23:23

数据输出：
A1跟B1一一对应，如果有一对一或者一对多的话，用红色将整行标示出，请问大侠们，使用VBA如何编辑代码实现，谢谢大家了。

JMM10B1RXOTG-0A	JMM10B1RXOTG-0105
JMM10B1RXOTG-0A	JMM10B1RXOTG-0105
JMM10B1RXOTG-0A	JMM10B1RXOTG-0105
JMM10B1RXOTG-0A	JMM10B1RXOTG-0105
JMM10B1RXOTG-0A	JMM10B1RXOTG-0105
JMM10B1RXOTG-0A	JMM10B1RXOTG-0105
JMM10B1RXOTG-0A	JMM10B1RXOTG-0105
JMM10B1RXOTG-0A	JMM10B1RXOTG-0105
JMM10B1RXOTG-0A	JMM10B1RXOTG-0105
JMM10B1RXOTG-0A	JMM10B1RXOTG-0105
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186

JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-1A	JMM10B1RXOTG-1186
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611
JMM10B1RXOTG-6C	JMM10B1RXOTG-611

附件是上千行的数据，谢谢！

最佳答案

月排行榜 / 总排行榜

TTTTT

2012-3-20 11:28

写了一个供参考.......

跳转到最佳答案楼层

zjcat35 · 发表于 2012-3-19 23:40

一对一或一对多标颜色，那不是全标颜色了！

maysh2009 · 发表于 2012-3-19 23:45

zjcat35 发表于 2012-3-19 23:40
一对一或一对多标颜色，那不是全标颜色了！

谢谢，是一对多或者多对一的情况下，将所在的行使用其他颜色标出，请问有什么方法呢，谢谢！

zjcat35 · 发表于 2012-3-20 08:36

我写了下代码，发现你这里都是一对一的情况，没有一对多，或者多对一

maysh2009 · 发表于 2012-3-20 08:48

zjcat35 发表于 2012-3-20 08:36
我写了下代码，发现你这里都是一对一的情况，没有一对多，或者多对一

谢谢您的热心帮助，这个是特殊情况，平时我处理的都有几条甚至十几条一对一或者一对多的情况的，由于手头暂时没有那种情况，待会我整理一份上去你测试看看，谢谢您！

maysh2009 · 发表于 2012-3-20 08:51

zjcat35 发表于 2012-3-20 08:36
我写了下代码，发现你这里都是一对一的情况，没有一对多，或者多对一

谢谢您的热心帮助，一对多或者多对一的情况已经上传，并且已经使用红色标示出来，谢谢！

求帮助.rar (40.42 KB, 下载次数: 9)

菜鸟锐 · 发表于 2012-3-20 09:13

完全没看明白，进来学习一下

maysh2009 · 发表于 2012-3-20 09:16

菜鸟锐发表于 2012-3-20 09:13
完全没看明白，进来学习一下

谢谢研究生的支持，谢谢！

豆丁 · 发表于 2012-3-20 09:20

本帖最后由豆丁于 2012-3-20 09:25 编辑

没看明白一对多是神马意思！

Sub test()
Dim arr, d, i%, mkey, arrt(), k%
Set d = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
For i = 1 To UBound(arr)
d(arr(i, 1) & "|" & arr(i, 2)) = d(arr(i, 1) & "|" & arr(i, 2)) + 1
Next
For Each mkey In d.keys
If d(mkey) = 1 Then
k = k + 1
ReDim Preserve arrt(1 To 2, 1 To k)
arrt(1, k) = Split(mkey, "|")(0)
arrt(2, k) = Split(mkey, "|")(1)
End If
Next
Range("d:e").ClearContents
[d1].Resize(UBound(arrt, 2), 2) = WorksheetFunction.Transpose(arrt)
End Sub

复制代码

maysh2009 · 发表于 2012-3-20 09:36

豆丁发表于 2012-3-20 09:20
没看明白一对多是神马意思！

JMM10B1RXOTG-0A JMM10B1RXOTG-0105
JMM10B1RXOTG-0A JMM10B1RXOTG-0105
JMM10B1RXOTG-0A JMM10B1RXOTG-0105
JMM10B1RXOTG-0A JMM10B1RXOTG-0105
JMM10B1RXOTG-0A JMM10B1RXOTG-0105
JMM10B1RXOTG-0A JMM10B1RXOTG-0105
JMM10B1RXOTG-0A JMM10B1RXOTG-0106
JMM10B1RXOTG-0A JMM10B1RXOTG-0107
JMM10B1RXOTG-0A JMM10B1RXOTG-0108
JMM10B1RXOTG-0A JMM10B1RXOTG-0109
JMM10B1RXOTG-0A JMM10B1RXOTG-0105
JMM10B1RXOTG-0A JMM10B1RXOTG-0105
JMM10B1RXOTG-0A JMM10B1RXOTG-0105
JMM10B1RXOTG-0A JMM10B1RXOTG-0105

这个就是一对多了，谢谢你
上面代码好像将一些一对一的数据也筛选出来了，谢谢

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