|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
略微提速- Sub test()
- Dim arr, brr, i&, j&, k&, st$, n&, x&, y&
- arr = Sheet1.Range("a1").CurrentRegion
- ReDim brr(1 To UBound(arr), 1 To 2)
- For i = 2 To UBound(arr)
- For j = i + 1 To UBound(arr)
- x = 0: y = 0
- For k = 2 To UBound(arr, 2)
- If arr(i, k) = arr(j, k) Then x = x + 1 Else y = y + 1
- If y > 4 Then Exit For
- Next
- If x > 14 Then
- n = n + 1
- brr(n, 1) = arr(i, 1) & "_" & arr(j, 1)
- brr(n, 2) = x
- End If
- Next
- Next
- Sheet2.Cells.ClearContents
- Sheet2.Range("a1").Resize(n, 2) = brr
- End Sub
复制代码 |
|