杭州桐庐县国税局:删除文本文件中相同的行

删除文本文件中相同的行！
如果不使用数据库，怎么样才能删除文本文件中相同的行呢？手工？！！10w行的记录你试试手工！？？
下面这个脚本演示了如果删除 文本文件中 相同的行！


Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001

Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
Const ForReading = 1, ForWriting = 2, ForAppending = 8


strPathToTextFile = "D:\"
strFile = "done.txt"

objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strPathtoTextFile & ";" & _
"Extended Properties=""text;HDR=NO;FMT=Delimited"""

objRecordSet.Open "Select DISTINCT * FROM " & strFile, _
objConnection, adOpenStatic, adLockOptimistic, adCmdText

Do Until objRecordSet.EOF
 str = objRecordSet.Fields.Item(0).Value
 Dim fso, f
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set f = fso.OpenTextFile("D:\namelist.txt", ForAppending, True)
 f.WriteLine str
 f.Close

objRecordSet.MoveNext
Loop



D:\done.txt 是原始文件
D:\namelist.txt 是生成后的文件

 

 

把上面这些代码，复制到一个txt文件中，修改成你所要的功能

另存为 *.vbs 后缀名就可以了！

 

===================================================

 

如何以A、B列为条件删除相同行

我想设定用宏直接删除相同行（比如：A1、B1与A4、B4数据相同则删除A4、B4行），请大师们帮助一下。谢谢！

 

2006-11-13 16:29 HOmT398参考
[CODE]
Sub test()
Dim mColl As New Collection
Dim iRow As Long, i As Long
Dim pt As Range
On Error Resume Next

With Sheet1
    iRow = .[a65536].End(xlUp).Row
    For i = 3 To iRow
    mColl.Add CStr(.Cells(i, 1) & .Cells(i, 2)), CStr(.Cells(i, 1) & .Cells(i, 2))
    If Err.Number <> 0 Then
        If pt Is Nothing Then
            Set pt = .Cells(i, 1)
        Else
            Set pt = Union(pt, .Cells(i, 1))
        End If
        Err.Clear
    End If
    Next
End With
pt.EntireRow.Select
End Sub
[/CODE]

 

2006-11-13 16:30 HOmT398替换空格一类的自己做 :P

如果数据很多的话加一句:
application.ScreenUpdating=False

[[i] 本帖最后由 HOmT398 于 2006-11-13 16:31 编辑 [/i]]

 

2006-11-13 17:37 yky888版主的方法很好！
进一步请教：我需要把d列的数据也加为条件，您的代码可作怎样的变通呢？
请看我的附件。谢谢！

 

2006-11-13 17:43 HOmT398[quote]原帖由 [i]yky888[/i] 于 2006-11-13 17:37 发表
版主的方法很好！
进一步请教：我需要把d列的数据也加为条件，您的代码可作怎样的变通呢？
请看我的附件。谢谢！ [/quote]

参考
[code]
Sub test()
Dim mColl As New Collection
Dim iRow As Long, i As Long
Dim pt As Range
Dim strKey As String
On Error Resume Next
With Sheet1
    iRow = .[a65536].End(xlUp).Row
    For i = 3 To iRow
    strKey = CStr(.Cells(i, 1) & .Cells(i, 2) & .Cells(i, 4))
    mColl.Add strKey, strKey
    If Err.Number <> 0 Then
        If pt Is Nothing Then
            Set pt = .Cells(i, 1)
        Else
            Set pt = Union(pt, .Cells(i, 1))
        End If
        Err.Clear
    End If
    Next
End With
pt.EntireRow.Select
End Sub
[/code]

 

2006-11-13 17:45 HOmT398回复 #4 yky888 的帖子

再改一改
[code]Sub test()
Dim mColl As New Collection
Dim iRow As Long, i As Long
Dim pt As Range
Dim strKey As String

On Error Resume Next
Application.ScreenUpdating = False
With Sheet1
    iRow = .[a65536].End(xlUp).Row
    For i = 3 To iRow
        strKey = CStr(.Cells(i, 1) & .Cells(i, 2) & .Cells(i, 4))
        If Len(strKey) > 0 Then
            mColl.Add strKey, strKey
            If Err.Number <> 0 Then
                If pt Is Nothing Then
                    Set pt = .Cells(i, 1)
                Else
                    Set pt = Union(pt, .Cells(i, 1))
                End If
                Err.Clear
            End If
        End If
    Next
End With
Application.ScreenUpdating=True
pt.EntireRow.Select
End Sub[/code]

===============================================

假设源文件叫dup.txt，用以下命令行生成过滤后的unique.txt：

copy /y nul unique.txt && for /f "delims=" %a in (dup.txt) do @(findstr /b /e /c:"%a" unique.txt >nul || echo.%a>>unique.txt)

效率不高，如果数据量特别大的话，慎用。