|
具体要求是:两个口令文件，文件是.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)
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2007-1-30 18:48
发表于 2007-2-1 22:04
