[已解决]求助:关于两组特定数据的互相替换的问题

1234vba

问题是这样的:

问题求助附件::: 2013-09-8.rar (6.88 KB, 下载次数: 6)

2013-9-8 18:13 上传

点击文件名下载附件

首先：
原1.txt 的内容 是和 新001.txt 的内容 是每行一一对应的.


例如:
原1.txt 的前5行数据,

000
001
002
003
004

新001.txt的前5行数据

936
104
068
211
360

······

test文件夹内的test1.txt文本
内容如下
936
068
211

因为是每一行对应每一行,一一对应

所以 用他们进行互换.

得到的结果写入

result文件夹下的result1.txt文本
内容如下：
000
002
003

······
可以这么理解、
假设原1.txt的数据为A，新001.txt的数据为B
分别取test文件夹下的文本数据（test1.txt，test2.txt……） 进行B→A的转换
最后把结果写入result文件夹下,保存的文件名为result1.txt,result2.txt……


同样，
test文件夹内的test2.txt文本
内容如下
104
068
360

互换运算后，得到的结果写入

result文件夹下的result2.txt文本
内容如下：
001
002
004


请教各位老师 如何用VBA实现该功能？？

最佳答案

月排行榜 / 总排行榜

liuguansky

2013-9-9 09:48

1. <div class="blockcode"><blockquote><div class="blockcode"><blockquote><div class="blockcode"><blockquote>Sub Test()
   
2.     Dim D As New Dictionary, F As New FileSystemObject
   
3.     Dim S$, Arr(1), i&, Fi As File, ArrTemp, K&, Ar() As String
   
4.     S = ThisWorkbook.Path
   
5.     Open S & "\新001.txt" For Input As #1
   
6.     Arr(0) = Split(StrConv(InputB(LOF(1), #1), vbUnicode), vbCrLf)
   
7.     Close #1
   
8.     Open S & "\原1.txt" For Input As #2
   
9.     Arr(1) = Split(StrConv(InputB(LOF(2), #2), vbUnicode), vbCrLf)
   
10.     Close #2
    
11.     For i = 0 To UBound(Arr(0))
    
12.         D.Add Arr(0)(i), Arr(1)(i)
    
13.         '若此行跳出错误，则表示新001中有重复记录
    
14.     Next i
    
15.     K = 2
    
16.     For Each Fi In F.GetFolder(S & "\test").Files
    
17.         K = K + 1
    
18.         Open Fi.Path For Input As #K
    
19.         ArrTemp = Split(StrConv(InputB(LOF(K), #K), vbUnicode), vbCrLf)
    
20.         Close #K
    
21.         ReDim Ar(0 To UBound(ArrTemp))
    
22.         For i = 0 To UBound(ArrTemp)
    
23.             If D.Exists(ArrTemp(i)) Then
    
24.                 Ar(i) = D(ArrTemp(i))
    
25.             End If
    
26.         Next i
    
27.         Open S & "\result\result" & K - 2 & ".txt" For Output As #K - 2
    
28.         Print #K - 2, Join(Ar, vbCrLf)
    
29.         Close #K - 2
    
30.     Next Fi
    
31. End Sub
    

复制代码

试试

跳转到最佳答案楼层

1234vba

1234vba

老师们早上好

liuguansky

1. <div class="blockcode"><blockquote><div class="blockcode"><blockquote><div class="blockcode"><blockquote>Sub Test()
   
2.     Dim D As New Dictionary, F As New FileSystemObject
   
3.     Dim S$, Arr(1), i&, Fi As File, ArrTemp, K&, Ar() As String
   
4.     S = ThisWorkbook.Path
   
5.     Open S & "\新001.txt" For Input As #1
   
6.     Arr(0) = Split(StrConv(InputB(LOF(1), #1), vbUnicode), vbCrLf)
   
7.     Close #1
   
8.     Open S & "\原1.txt" For Input As #2
   
9.     Arr(1) = Split(StrConv(InputB(LOF(2), #2), vbUnicode), vbCrLf)
   
10.     Close #2
    
11.     For i = 0 To UBound(Arr(0))
    
12.         D.Add Arr(0)(i), Arr(1)(i)
    
13.         '若此行跳出错误，则表示新001中有重复记录
    
14.     Next i
    
15.     K = 2
    
16.     For Each Fi In F.GetFolder(S & "\test").Files
    
17.         K = K + 1
    
18.         Open Fi.Path For Input As #K
    
19.         ArrTemp = Split(StrConv(InputB(LOF(K), #K), vbUnicode), vbCrLf)
    
20.         Close #K
    
21.         ReDim Ar(0 To UBound(ArrTemp))
    
22.         For i = 0 To UBound(ArrTemp)
    
23.             If D.Exists(ArrTemp(i)) Then
    
24.                 Ar(i) = D(ArrTemp(i))
    
25.             End If
    
26.         Next i
    
27.         Open S & "\result\result" & K - 2 & ".txt" For Output As #K - 2
    
28.         Print #K - 2, Join(Ar, vbCrLf)
    
29.         Close #K - 2
    
30.     Next Fi
    
31. End Sub
    

复制代码

试试

1234vba

好的 谢谢liuguansky老师,我先下载测试