[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖
本帖最后由 WHY 于 2020-1-10 15:17 编辑
  1. REM 从m个数据中选取n个数求组合VBS(m>=n>0)
  2. Dim m, n, file
  3. m = 200
  4. n = 2
  5. file = "Result.txt"
  6. Dim strTmp, s, fso, arrIn, arrOut, x
  7. strTmp = ""
  8. s = ""
  9. x = 0
  10. Set fso = CreateObject("Scripting.FileSystemObject")
  11. ReDim arrIn(m)                        '定义输入数组
  12. ReDim arrOut(x)                       '定义输出数组
  13. Dim i
  14. For i = 1 To m
  15.     arrIn(i-1) = Right(1000 + i, 3)   '输入数组赋值
  16.     If i <= n Then
  17.         s = s + " " + arrIn(i-1)
  18.         strTmp = strTmp + "1"
  19.     Else
  20.         strTmp = strTmp + "0"
  21.     End If
  22. Next
  23. arrOut(x) = Mid(s, 2)                 '输出数组赋值
  24. Dim reg1, reg2
  25. Set reg1 = New RegExp
  26. Set reg2 = New RegExp
  27. reg1.Pattern = "1"
  28. reg1.Global  = True
  29. reg2.Pattern = "^(0*)(1*)10"
  30. Do while InStr(strTmp, "10") > 0
  31.     s = ""
  32.     x = x + 1
  33.     ReDim Preserve arrOut(x)
  34.     strTmp = reg2.Replace(strTmp, "$2$101")  '交换strTmp行首0和1,第一个10改成01
  35.     Dim match
  36.     For Each match In reg1.Execute(strTmp)
  37.         s = s + " " + arrIn(match.FirstIndex)
  38.     Next
  39.     arrOut(x) = Mid(s, 2)            '输出数组赋值
  40.     If x = 5000 Then                 '最大下标为5000时写入文本,并清空arrOut
  41.         x = 0
  42.         fso.OpenTextFile(file, 8, True).Write Join(arrOut, vbCrLf)
  43.         ReDim arrOut(x)
  44.     End If
  45. Loop
  46. If x > 0 Then fso.OpenTextFile(file, 8, True).Write Join(arrOut, vbCrLf)
  47. MsgBox "Done"
复制代码

TOP

返回列表