WHY

Test.vbs

Rem On Error Resume Next
Dim srcDir, dstDir
 
srcDir = "E:\Test\新建文件夹"           '源文件夹路径，需替换为实际路径
dstDir = "E:\Test\新建文件夹1"          '目标文件夹路径
 
Dim wsc
Set wsc = CreateObject("WScript.Shell")
 
If WSH.Arguments.Count = 0 Then
    wsc.Run "cscript " & chr(34) & WSH.ScriptFullName & chr(34) & " ARG", 0
    WScript.Quit
End If
 
Dim dic1, fso
Set dic1 = CreateObject("Scripting.Dictionary")
Set fso  = CreateObject("Scripting.FileSystemObject")
 
Dim reg
Set reg     = New RegExp
reg.Pattern = "[ \t]+"
reg.Global  = True
 
Dim objExec
If Not fso.FolderExists(srcDir) Then MsgBox "源文件夹不存在" : WSH.Quit
wsc.Run "cmd /c md " & chr(34) & dstDir & chr(34) & " 2>nul", 0              '创建目标文件夹
Set objExec = wsc.Exec( "cmd /c dir /b /a-d /s " & chr(34) & srcDir & "\*.txt" & chr(34) )  '遍历源文件夹
 
Rem 字典dic1，key=文件名，value=文件路径
Dim strFilePath, strFileName
Do Until objExec.StdOut.AtEndOfStream
    strFilePath = objExec.StdOut.ReadLine
    strFileName = fso.GetFile(strFilePath).Name
    strFileName = LCase(strFileName)
    If Not dic1.Exists(strFileName) Then
        dic1.Add strFileName, strFilePath
    Else
        dic1.Item(strFileName) = dic1.Item(strFileName) & vbLf & strFilePath
    End If
Loop
 
Rem 遍历字典dic1
Dim key
For Each key In dic1.Keys 
    GetFileContent key, Split( Dic1.Item(key), vbLf )
Next
 
Function GetFileContent(fileName, ByRef arrFilePath)
    Dim dic2, i, objFile, strLine
    Set dic2 = CreateObject("Scripting.Dictionary")
 
    For i = 0 To UBound(arrFilePath)
        Set objFile = fso.OpenTextFile(arrFilePath(i), 1)
        Do Until objFile.AtEndOfStream
            strLine = objFile.ReadLine
            strLine = reg.Replace(strLine, "|")                                       '空格替换为"|"
            If UBound(Split(strLine, "|")) >= 2 And InStr(strLine, "-QQ") <= 0 Then   '如果大于等于3列、不含 "-QQ"
                strLine = Replace(Replace(strLine,"SZ", "0|"),"SH", "1|")             '替换 "SZ" 和 "SH"
                If Not dic2.Exists(strLine) Then                                      '字典dic2，用于去重复
                    dic2.Add strLine, True
                End If
            End If 
        Loop
        objFile.Close
        Set objFile = Nothing
    Next
 
    fso.OpenTextFile(dstDir & "\" & fileName, 2, True).Write( Join(dic2.Keys, vbCrLf) )    '保存
    Set dic2 = Nothing
End Function
 
MsgBox "Done"COPY

Test.PS1

$dt = get-Date;
 
$srcDir = 'E:\Test\新建文件夹';
$dstDir = 'E:\Test\新建文件夹1';
 
If (![IO.Directory]::Exists($dstDir)){ $null = md $dstDir }
 
$dic = New-Object 'System.Collections.Generic.Dictionary[string, [Collections.ArrayList]]';
 
forEach( $file In (dir $srcDir -Recurse -Filter '*.txt') ){
    $Name = $file.BaseName.ToUpper();
    $Path = $file.FullName;
    if( !$dic.ContainsKey($Name) ){
        $dic.Add($Name, @($Path));
    } else {
        [void]$dic[$Name].Add($Path);
    }
}
 
forEach( $key In $dic.Keys ){
    $Hash = @{};
    for( $i=0; $i -lt $dic[$key].Count; $i++ ){
        $arr = [IO.File]::ReadAllLines($dic[$key][$i], [Text.Encoding]::Default);
        $arr = $arr -match '^(?:(?!-QQ)\S)+\s+\S+\s+\S+';
        $arr = $arr -replace '\s+', '|' -replace 'SZ', '0|' -replace 'SH', '1|';
        $Count = $arr.Count;
        for( $j=0; $j -lt $Count; $j++ ){
            if( !$Hash.ContainsKey($arr[$j]) ){
                $Hash.Add($arr[$j], $True);
            }
        }
    }
    [IO.File]::WriteAllLines( $dstDir + '\' + $key + '.txt', $Hash.Keys );
}
((get-Date) - $dt).TotalSeconds;COPY

WHY

回复 59# xczxczxcz


    过奖，
感谢测试。
在我的电脑上，vbs 用时 3.5 分钟，PowerShell 脚本用时 2.1 分钟