本帖最后由 WHY 于 2023-3-3 16:12 编辑
回复 18# 思想之翼
这个问题得看电脑硬件配置了,我的电脑配置不咋地,多线程没想去玩。
每一行数据要循环处理201376次,然后又要写磁盘201376次,如果有10000行数据,别指望能快到哪去。
改一下,每读取2行数据开始写磁盘,减少循环等待时间及字典空间占用,我没有过多测试。你试试吧。- Dim myPath, srcFile, dstFolder
- myPath = Left(WSH.ScriptFullName, InStrRev(WSH.ScriptFullName, "\")) '脚本所在路径
- srcFile = myPath & "1.txt" '源文本文件
- dstFolder = myPath & "result" '目标目录
-
- Dim fso
- Set fso = CreateObject("Scripting.FileSystemObject")
- If Not fso.FolderExists(dstFolder) Then fso.CreateFolder(dstFolder) '创建目标目录
-
- Dim c, objDic, objFile
- c = 5 'N选5组合
- Set objDic = CreateObject("Scripting.Dictionary") '字典,存放结果
- Set objFile = fso.OpenTextFile(srcFile, 1) '打开源文件
-
- Dim num, strLine
- num = 0
- While Not objFile.AtEndOfStream
- num = num + 1
- strLine = objFile.ReadLine '逐行读取源文件
- GetCombination strLine, c, objDic '求组合
- If num Mod 2 = 0 Then '每读取2行开始写入文件
- SaveToFile objDic
- objDic.RemoveAll '清空字典
- End If
- Wend
- If objDic.Count > 0 Then SaveToFile objDic '字典不为空,写入文件
- objFile.Close
-
- Function SaveToFile(ByRef oDict)
- Dim key, dstFile, f
- For Each key In oDict.Keys
- dstFile = dstFolder & "\" & Right("000000" & key, 6) & ".txt" '目标文件名
- Set f = fso.OpenTextFile(dstFile, 8, True)
- f.Write(oDict.Item(key)) '写入目标文件
- f.Close
- Next
- End Function
-
- Function GetCombination(ByRef strLine, c, ByRef oDict)
- Dim key, str, i
- key = 1
- str = ""
- For i = 1 To Len(strLine) 'str赋值:11111000000000000000000000000000 共32位
- If i <= c Then
- str = str & "1"
- Else
- str = str & "0"
- End If
- Next
-
- If Not oDict.Exists(key) Then oDict.Add key, ""
- oDict.Item(key) = oDict.Item(key) & Left(strLine, c) & vbCrLf '字典,赋初始值
-
- Dim reg
- Set reg = New RegExp '创建正则表达式
- reg.Pattern = "10(?=(0*))\1(?=(1*))\2$"
-
- While InStr(str, "10") > 0
- Dim s
- s = ""
- str = reg.Replace(str, "01$2$1") 'str值交换 10 <--> 01
- For i = 1 To Len(str)
- If Mid(str, i, 1) = "1" Then s = s & Mid(strLine, i, 1) '查找"1"与strLine对应的字符
- If Len(s) = c Then Exit For '找到5个,退出For
- Next
- key = key + 1
- If Not oDict.Exists(key) Then oDict.Add key, ""
- oDict.Item(key) = oDict.Item(key) & s & vbCrLf '字典,赋值
- Wend
- End Function
-
- MsgBox "Done"
复制代码
|