- Sub aaa()
- Dim arr, i&, a&, b&, c&, brr, n&, s$
- arr = [f3].CurrentRegion
- ReDim brr(1 To UBound(arr), 1 To 6)
- For i = 1 To UBound(arr)
- s = arr(i, 1)
- For a = 1 To 3
- For b = 1 To 3
- For c = 1 To 3
- If a <> b And b <> c And a <> c Then
- n = n + 1
- brr(i, n) = Mid(s, a, 1) & Mid(s, b, 1) & Mid(s, c, 1)
- End If
- Next c
- Next b
- Next a
- n = 0
- Next i
- [h3].Resize(UBound(arr), 6) = brr
- End Sub
复制代码 |