批处理之家 - Powered by Discuz! Board

标题: [文本处理] 求助；文件夹中有200个txt文本文件想随机选取2个不重复的另存 [打印本页]

作者: hkldd 时间: 2019-12-28 17:42 标题: 求助；文件夹中有200个txt文本文件想随机选取2个不重复的另存

各位老师；我有一个文件中有200个txt文本文件，想随机毎次抽取2个文本文件，保存到一个按数字序号命名文件夹中，要求不重复不断的抽取，也不知能组合成多少个文件，想请各位老师写个批处理，让我测试一下，谢谢！
文件中的txt文本文件已经是按数字命名的(001.txt、002.txt、003.txt……200.tx)，想得到按数序递增的文件夹(例如01号中有001.txt、002.txt、02号有002.txt、003.txt等，)只要不重复就可以，一直随机抽

作者: hlzj88 时间: 2019-12-29 08:44

所谓随机，就不应当有 01号中有001.txt、002.txt 这样有序排列的描述。
所谓不重复，用过了就不可以再用，200/2 只能有100种组合。一个箱子内有200个球，你左右手都一次只能取一个，问双手同时取多少次能取完。

作者: hkldd 时间: 2019-12-29 10:15

呵呵，可能是我没描述清楚，是这样的，在一个文件夹中有编号001.txt至200.txt命名的文档，毎次随机抽2个文本保存到一个新文件夹中，所抽取的文本不重复，新文件夹也用数字顺序命名就行，想了解这200个文本到底能组合多少个文件

作者: went 时间: 2019-12-29 12:31

不重复，是每个文件只出现一次，还是抽取的两个文件的组合只出现一次？
是想得到组合成的文件，还是只需要得到能组合的个数？

作者: hkldd 时间: 2019-12-29 22:12

@went；毎次都是在200个文件夹中随机抽取，不重复是指，两个文件的组合只出现一次，想得到这些组合成的文件全部组合

作者: hlzj88 时间: 2019-12-30 05:38

回复 5# hkldd
你的意思是假设已有一次完整的200/2的完整组合后，假设我们只对其中两次的随机数进行了交换，这样的又算100次，以此类推，所有的共能有多少组合机会。假设是这样问，也是可以有答案的。好像在高中就学过这种排列组合题，哎，当年我学的太差了。会有人列出来的。

作者: FOR 时间: 2019-12-31 19:21

@echo off&setlocal enabledelayedexpansion
set /a wjj=1000000,w=1200
for /l %%i in (1001 1 !w!) do (
	set /a n=%%i+1
	for /l %%j in (!n! 1 !w!) do (
		set /a wjj+=1
		set var=%%i&set num=%%j
        echo !var:~-3!  !num:~-3! = !wjj:~-5!
	)
)
echo;
pause
复制代码

作者: WHY 时间: 2020-1-6 23:40

本帖最后由 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"
复制代码

欢迎光临批处理之家 (http://www.bathome.net/)

Powered by Discuz! 7.2