本帖最后由 apang 于 2015-2-26 15:54 编辑
- Dim srcDir, dstDir, fso
- srcDir = "D:\数据1"
- dstDir = "D:\数据2"
- Set fso = CreateObject("Scripting.FileSystemObject")
- If Not fso.FolderExists(dstDir) Then fso.CreateFolder(dstDir)
-
- Dim i, f1, f2, f, objFile1, objFile2, s1, s2
- For i = 1001 to 1210
- f1 = srcDir & "\" & Mid(i, 2) & "_1.txt"
- f2 = srcDir & "\" & Mid(i, 2) & "_2.txt"
- If fso.FileExists(f1) and fso.FileExists(f2) Then
- f = dstDir & "\" & Mid(i, 2) & ".txt"
- Set objFile1 = fso.OpenTextFile(f1, 1)
- Set objFile2 = fso.OpenTextFile(f2, 1)
- s1 = RegEx(objFile1.ReadAll)
- s2 = RegEx(objFile2.ReadAll)
- objFile1.Close
- objFile2.Close
- fso.OpenTextFile(f, 2, true).Write CombineNum(s1, s2)
- End If
- Next
-
- MsgBox "OK"
-
- ''删除空白行
- Function RegEx(txt)
- Dim re
- Set re = New RegExp
- re.Pattern = "^(\s*\n)+"
- txt = re.Replace(txt, "")
- re.Pattern = "(\s*\n)+"
- re.Global = true
- RegEx = re.Replace(txt & vbLf, vbLf)
- End Function
-
- ''合并数据
- Function CombineNum(ByVal s1, ByVal s2)
- Dim ar1, ar2, j, k, n, s, m, str
- ar1 = Split(s1, vbLf)
- ar2 = Split(s2, vbLf)
- For j = 0 to UBound(ar1) - 1
- For k = 0 to UBound(ar2) - 1
- s = ""
- For n = 1 to 10
- m = n Mod 10
- If InStr(ar1(j) & ar2(k), m)=0 Then s = s & m
- Next
- If Len(s) = 3 and InStr(str, s) = 0 Then
- str = str & s & vbCrLf
- End If
- Next
- Next
- CombineNum = str
- End Function
复制代码
|