VB6 Collection实现百万文本去重

上一篇数组的去重说到，对于千次计算以上的去重基本上特别的吃力，这里就介绍一种方法，通过Collection集合对象来过滤重复。

Option Explicit

'//By: InkHin

'// 参考：https://bbs.csdn.net/topics/350065116

'引用：Microsoft scriptiong Runtime

'感谢 析弱大叔 qq: 1265382638  的指点.

'// 2019-03-10

'// 测试 Collection 去重 百万条文本数据过滤

'// 请编译执行

Private Function Out_Remove_Same(ByVal Path As String, ByVal InName As String, ByVal OutName As String)
Dim col As Collection
    Set col = New Collection
    Dim fso As Variant
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim stream1 As Scripting.TextStream

    'Function BuildPath(Path As String, Name As String) As String  '目录路径 文件名称

    Set stream1 = fso.OpenTextFile(fso.BuildPath(Path, InName), ForReading, False)

    Dim stream2 As Scripting.TextStream

    Set stream2 = fso.OpenTextFile(fso.BuildPath(Path, OutName), ForWriting, True)

    While Not stream1.AtEndOfStream
        Dim strLine As String
        strLine = stream1.ReadLine

        Dim vntValue As Variant
        vntValue = Empty

        On Error Resume Next
        vntValue = col.Item(strLine)
        On Error GoTo 

        If IsEmpty(vntValue) Then
            Call col.Add(Null, strLine)
            Call stream2.WriteLine(strLine)
        End If
    Wend

    Call stream1.Close
    Call stream2.Close
End Function