本帖最后由 WHY 于 2020-1-10 15:17 编辑
- REM 从m个数据中选取n个数求组合VBS(m>=n>0)
- Dim m, n, file
- m = 200
- n = 2
- file = "Result.txt"
-
- Dim strTmp, s, fso, arrIn, arrOut, x
- strTmp = ""
- s = ""
- x = 0
- Set fso = CreateObject("Scripting.FileSystemObject")
- ReDim arrIn(m) '定义输入数组
- ReDim arrOut(x) '定义输出数组
-
- Dim i
- For i = 1 To m
- arrIn(i-1) = Right(1000 + i, 3) '输入数组赋值
- If i <= n Then
- s = s + " " + arrIn(i-1)
- strTmp = strTmp + "1"
- Else
- strTmp = strTmp + "0"
- End If
- Next
- arrOut(x) = Mid(s, 2) '输出数组赋值
-
- Dim reg1, reg2
- Set reg1 = New RegExp
- Set reg2 = New RegExp
- reg1.Pattern = "1"
- reg1.Global = True
- reg2.Pattern = "^(0*)(1*)10"
-
- Do while InStr(strTmp, "10") > 0
- s = ""
- x = x + 1
- ReDim Preserve arrOut(x)
- strTmp = reg2.Replace(strTmp, "$2$101") '交换strTmp行首0和1,第一个10改成01
-
- Dim match
- For Each match In reg1.Execute(strTmp)
- s = s + " " + arrIn(match.FirstIndex)
- Next
- arrOut(x) = Mid(s, 2) '输出数组赋值
-
- If x = 5000 Then '最大下标为5000时写入文本,并清空arrOut
- x = 0
- fso.OpenTextFile(file, 8, True).Write Join(arrOut, vbCrLf)
- ReDim arrOut(x)
- End If
- Loop
-
- If x > 0 Then fso.OpenTextFile(file, 8, True).Write Join(arrOut, vbCrLf)
-
- MsgBox "Done"
复制代码
|