- Sub text()
- Dim d As Object
- Set d = CreateObject("scripting.dictionary")
- Dim arr, i&, j&
- arr = [c1:g1]
- For i = 1 To UBound(arr)
- For j = 1 To UBound(arr, 2)
- d(arr(i, j)) = arr(i, j)
- Next
- Next
- Dim brr, n&, n1&
- brr = [b2:h2]
- For i = 1 To UBound(brr, 2)
- If d.exists(brr(1, i)) Then
- Cells(4, 2).Offset(0, n) = brr(1, i)
- n = n + 1
- End If
- Next
- For i = 1 To UBound(brr, 2)
- d(brr(1, i)) = brr(1, i)
- Next
- Dim crr
- crr = [b4].CurrentRegion
- For j = 1 To UBound(crr, 2)
- If d.exists(crr(1, j)) Then d.Remove (crr(1, j))
- Next
- [b5].Resize(1, d.Count) = Application.Transpose(Application.Transpose(d.keys))
- Call b
- End Sub
复制代码
能提取相同的,但是不同的显示不完全。只能显示一部分。。。 |