本帖最后由 zjdh 于 2012-2-5 07:56 编辑
Sub test()
Dim a, Ar(1 To 10000, 1 To 1)
a = [a6:bz8]
For j% = 1 To UBound(a, 2) - 2
s1$ = "": s2$ = "": s3$ = ""
For i% = 1 To 5
stmp1$ = Mid(a(1, j), i, 1)
If InStr(a(1, j + 1), stmp1) > 0 And InStr(a(1, j + 2), stmp1) > 0 Then s1 = s1 & "," & stmp1
stmp1$ = Mid(a(2, j), i, 1)
If InStr(a(2, j + 1), stmp1) > 0 And InStr(a(2, j + 2), stmp1) > 0 Then s2 = s2 & "," & stmp1
stmp1$ = Mid(a(3, j), i, 1)
If InStr(a(3, j + 1), stmp1) > 0 And InStr(a(3, j + 2), stmp1) > 0 Then s3 = s3 & "," & stmp1
Next i
If s1 <> "" And s2 <> "" And s3 <> "" Then
For Each k1 In Split(Mid(s1, 2), ",")
For Each k2 In Split(Mid(s2, 2), ",")
For Each k3 In Split(Mid(s3, 2), ",")
R = R% + 1
Ar(R, 1) = k1 & k2 & k3
Next
Next
Next
End If
Next j
Range("c15:c6755").Clear
If R = 0 Then Exit Sub
Range("c15").Resize(R).NumberFormat = "@"
Range("c15").Resize(R) = Ar
End Sub |