|
用字符串比较也行,速度稍微慢一点。- Sub tt()
- Dim L
- arr = Range("a1:a150000")
- For i = 1 To UBound(arr) '15万数据组成字符串
- x = x & arr(i, 1)
- Next
- Dim xrr(1 To 3, 1 To 8)
- [d:k].ClearContents
- For k = 1 To 24
- If n > 0 Then Exit For '如果上一组已有比较结果,则结束
- L = 26 - k
- y = Join(Application.Transpose(Range(Cells(k, 2), Cells(25, 2))), "") '本组待比较的字符串
- n = 0 '本组比较开始
- tmp = 1
- For m = 1 To 3 '最多比较3次
- p = InStr(tmp, x, y) '字符串x,从位置tmp开始,是否存在字符串y
- If p = 0 Then Exit For
- n = n + 1
- xrr(n, 1) = p + L
- For kk = 2 To 8
- xrr(n, kk) = arr(p + L + kk - 2, 1)
- Next
- tmp = p + 1
- Next
- Next
- msg = IIf(n > 0, "比对数据长度:" & 27 - k, "比较失败,无匹配结果")
- If n > 0 Then Cells(k * 4 - 7, 4).Resize(n, 8) = xrr
- MsgBox msg
- End Sub
复制代码 |
|