VBA比较一个目录下的两个.txt文件.

stanleypan

具体要求是:两个口令文件，文件是.txt的，内容格式是一行一个口令。如何用VBA比较这个目录下的两个.txt文件(a.txt, b.txt)，且生成c.txt，c.txt的结果是：a.txt、 b.txt 两个文件相比较之后，删除了两个文件中相同的内容，而留下了两个文件中不同的内容！

Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub Testing()
Dim arFirstArray() As String
Dim arSecondArray() As String
Dim arr() As String
Dim arResults() As String   '两者共有的内容.
Dim Num1, Num2 As Long
Dim temp As String   '-----读出的内容
Dim g As Long
Application.ScreenUpdating = False
   Open ThisWorkbook.Path & "\" & "a.txt" For Input As #1
   Do Until EOF(1)
      Num1 = Num1 + 1
      ReDim Preserve arFirstArray(0 To Num1)
      Line Input #1, temp
      arFirstArray(Num1 - 1) = temp
   Loop
   Close #1
   '   For i = LBound(arFirstArray) To UBound(arFirstArray)
   '      Debug.Print arFirstArray(i)
   '   Next
   Open ThisWorkbook.Path & "\" & "b.txt" For Input As #1
   Do Until EOF(1)
      Num2 = Num2 + 1
      ReDim Preserve arSecondArray(0 To Num2)
      Line Input #1, temp
      arSecondArray(Num2 - 1) = temp
   Loop
   Close #1
   '----两数组合并成一个数组
   ReDim Preserve arr(0 To UBound(arFirstArray) + UBound(arSecondArray))
   Dim i As Long
   For i = 0 To UBound(arFirstArray)
      arr(i) = arFirstArray(i)
   Next i
   For i = 0 To UBound(arSecondArray)
      arr(UBound(arFirstArray) + i) = arSecondArray(i)
   Next i
   '   For i = LBound(arr) To UBound(arr)
   '      Debug.Print arr(i)
   '   Next
   g = GetTickCount   'measures the speed of the process
   Compare arr   '相关数组处理.
   Application.ScreenUpdating = True
   MsgBox "Time consumption: " & Round((GetTickCount - g) / 1000, 3) & " seconds" & vbCrLf & "Items left in the array: " & (UBound(arr) + 1) & vbCrLf & "Original size: " & UBound(arFirstArray) + UBound(arSecondArray), vbInformation
      '--output
   Open ThisWorkbook.Path & "\output.txt" For Output As #1
   For g = 0 To UBound(arr)
      Print #1, arr(g)
   Next g
   Close #1

End Sub
Private Function Compare(ByRef arr() As String) As String
Dim arru As Long
Dim arrl As Long
Dim g As Long
Dim g2 As Long
Dim remcount As Long
Dim stepback As Boolean
'要求是删除了两个文件中相同的内容，而留下了两个文件中不同的内容！
   arru = UBound(arr)
   arrl = LBound(arr)
   For g = arrl To arru
      For g2 = (g + 1) To arru
         If arr(g) = arr(g2) Then
            '如果都相等,则通通为空
            Debug.Print arr(g)
            arr(g) = vbNullString   '-------
            arr(g2) = vbNullString
            remcount = remcount + 1
         End If
      Next g2
   Next g
   remcount = 0
   For g = arrl To arru
      If g + remcount > arru Then Exit For
      If stepback = True Then g = g - 1: stepback = False
      If arr(g) = vbNullString Then
         remcount = remcount + 1
         For g2 = g To arru - 1
            arr(g2) = arr(g2 + 1)
            If arr(g2 + 1) = vbNullString Then stepback = True
            arr(g2 + 1) = vbNullString
         Next g2
      End If
   Next g
   ReDim Preserve arr(arru - remcount) As String
End Function

6NJzj0DO.zip (10.66 KB, 下载次数: 92)

2007-1-30 18:48 上传

点击文件名下载附件
VBA比较一个目录下的两个.txt文件.

yuanzhuping

收下慢慢学习,谢了.

andysky

用DOS也可以啊，简单几倍。

fc 1.txt 2.txt >3.txt

[此贴子已经被作者于2007-2-2 18:18:06编辑过]

zxynrg

用 dos 怎么用啊

esnake

古老的DOS命令，其实可以实现很多意想不到的功能

hanyinghao0608

你好，我是一个菜鸟，你的这个程序很好，但是我看不懂VB，你能不能帮我修改成我想要的，我想要的是 比较两个TXT文件然后合并，将其中相同的只保留一次。

非常感谢

xingheshouwang

顶一个，支持楼主写出更好的代码