excel两行对比，然后处理难题

mmyu8888

对比表格里两行里的串号是否相同，如果相同把其中相同的一行放到另一个工作表里，注：相同两行有可能是别的数据不同但串号是相同的。例子在附件里，希望各位可以帮忙解决个大难题。

btfan77

Private Sub CommandButton1_Click()

Dim sFind As String, sReplace As String '定义查找与被查找的字符串变量
Dim I As Integer, J As Integer '定义循环中的循环增长数值
   

For I = 1 To 200 '在1列中循环处理并查找姓名
sFind = Cells(I, 1).Value '将sFind赋予姓名单元格的数值

For J = 1 To 200 '在3列中循环处理并查找姓名
sReplace = Cells(J, 3).Value '将sReplace赋予姓名单元格的数值

If sFind = sReplace Then '如果查找的姓名与被查找的姓名相等
Cells(I, 1).Select
With Selection.Interior
.ColorIndex = 7
End With
Cells(J, 3).Select
With Selection.Interior
.ColorIndex = 7
End With

Exit For '查找的目标已达到，跳出For循环，减少无谓的资源浪费

End If
   Next
Next

End Sub

‘修改一下就可以用，对比两列数据，相同的就高亮出来

laosanjie

mmyu8888 发表于 2011-7-5 23:01
对比表格里两行里的串号是否相同，如果相同把其中相同的一行放到另一个工作表里，注：相同两行有可能是别的 ...

1、楼主的表1里只有3行数据？！数据太少没办法看出其中的要求和规律．

2、串号相同的行是只有2个？还是有3个或更多？

3、串号相同的行是否都是相邻的2行？还是也有不相邻的？

旭日升

可以使用高级筛选，勾上“选择不重复的记录”，然后将记录复制过去，操作快捷，简单。

代码：
Sub SLKD()
Dim D As Object, I&, J&, ARR, BRR, T, S
Set D = CreateObject("SCRIPTING.DICTIONARY")
ARR = ActiveSheet.UsedRange
For I = 1 To UBound(ARR)
    If Not D.EXISTS(ARR(I, 3)) Then
        D(ARR(I, 3)) = Join(Array(ARR(I, 1), ARR(I, 2), ARR(I, 3), ARR(I, 4), ARR(I, 5), ARR(I, 6)), vbCrLf)
    End If
Next
T = Application.Transpose(D.ITEMS)
ReDim BRR(1 To UBound(T), 1 To 6)
For I = 1 To UBound(T)
    S = Split(T(I, 1), vbCrLf)
    For J = 1 To UBound(S) + 1
        BRR(I, J) = S(J - 1)
    Next
Next
Sheets(2).[A1].Resize(UBound(T), 6) = BRR
End Sub