|
楼主 |
发表于 2019-1-20 21:04
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 dsmch 于 2019-1-20 21:16 编辑
引申一下,男女女、男女女……女男男、女男男……不要想污了,不是3P,代码该如何写?- Sub dsmch()
- arr = Range("a1").CurrentRegion
- For i = 2 To UBound(arr)
- p = "": p3 = ""
- For j = 2 To UBound(arr, 2) '单双(10)
- p = p & arr(i, j) Mod 2
- Next
- If arr(i, 2) Mod 2 = 1 Then
- zf = "100": GoSub 100
- For j = 3 To Len(p2) Step 3
- If Val(Mid(p2, j, 1)) - Val(Mid(p2, j - 2, 1)) < 0 And Val(Mid(p2, j - 1, 1)) - Val(Mid(p2, j - 2, 1)) < 0 Then p3 = p3 & " " & Mid(p2, j - 2, 3)
- Next
- p2 = Mid(p3, 2)
- Else
- zf = "011": GoSub 100
- For j = 3 To Len(p2) Step 3
- If Val(Mid(p2, j, 1)) - Val(Mid(p2, j - 2, 1)) > 0 And Val(Mid(p2, j - 1, 1)) - Val(Mid(p2, j - 2, 1)) > 0 Then p3 = p3 & " " & Mid(p2, j - 2, 3)
- Next
- p2 = Mid(p3, 2)
- End If
- Cells(i, "o") = p2
- Next
- Exit Sub
- 100:
- s = 1: p2 = ""
- Do Until s = 0
- For k = 1 To Len(zf)
- Z = Mid(zf, k, 1)
- y = InStr(s, p, Z)
- If y <> 0 Then p2 = p2 & arr(i, y + 1): s = y + 1 Else Exit Do
- Next
- Loop
- Return
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|