- Dim i, j, srcFile, dstFile1, dstFile2
- For i = 1 To 1624
- For j = 1 To 7
- srcFile = "e:\ZA\" & Right("00000" & i, 6) & "\"& Right("00000" & i, 6) & "_" & j & ".txt"
- dstFile1 = "e:\ZD\" & Right("00000" & i, 6) & "\"& Right("00000" & i, 6) & "_" & j & ".txt"
- dstFile2 = "e:\ZS\" & Right("00000" & i, 6) & "\"& Right("00000" & i, 6) & "_" & j & ".txt"
- GetStr srcFile, dstFile1, dstFile2
- Next
- Next
-
- Function GetStr(srcFile, dstFile1, dstFile2)
- Dim max, min
- max = 0 '最大值初始化
- min = CLng(1000000000) '最小值初始化
-
- Dim fso, objFile, objDic
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set objFile = fso.OpenTextFile(srcFile, 1)
- Set objDic = CreateObject("Scripting.Dictionary")
-
- Dim strIn, strLine
- strIn = ""
- Do Until objFile.AtEndOfStream
- strLine = objFile.ReadLine
- If strLine <> "" Then strIn = strLine & strIn
- Loop
- objFile.Close()
-
- Dim i, k
- For i = Len(strIn)-1 To 1 Step -1
- k = Left(strIn, i)
- If InStr(2, strIn, k) > 0 Then
- MsgBox k
- SaveToDictionary objDic, strIn, k
- Exit For
- End If
- Next
-
- Dim s1, s2, key
- s1 = "" '次数最多的字符
- s2 = "" '次数最少的字符
- For Each key In objDic.Keys '遍历字典
- If objDic.Item(key) > max Then '最大值
- max = objDic.Item(key)
- s1 = key & vbCrLf
- ElseIf objDic.Item(key) = max Then
- s1 = s1 & key & vbCrLf
- End If
- If objDic.Item(key) < min Then '最小值
- min = objDic.Item(key)
- s2 = key & vbCrLf
- ElseIf objDic.Item(key) = min Then
- s2 = s2 & key & vbCrLf
- End If
- Next
-
- fso.OpenTextFile(dstFile1, 2, True).Write(s1) '写入文本,次数最多的字符
- fso.OpenTextFile(dstFile2, 2, True).Write(s2) '写入文本,次数最少的字符
- Set objDic = Nothing
- Set fso = Nothing
- End Function
-
- Function SaveToDictionary(dic, str, pattern)
- Dim reg, match, key
- Set reg = New RegExp
- reg.Global = True
- reg.Pattern = ".(?=" & pattern & ")"
- For Each match In reg.Execute(str)
- key = match.Value
- If Not dic.Exists(key) Then
- dic.Add key, 1 '字典赋值
- Else
- dic.Item(key) = dic.Item(key) + 1
- End If
- Next
- End Function
-
- MsgBox "Done"
复制代码
|