请教:如何删除txt文件中重复的行
本人疑问:
在txt文件中,如何去掉里面重复的行,每行的长短不一,但是形式一样,都是用12个";"将其分开。
文件大小在1M左右。
本人VB刚入门,此问题一直困惑着本人在工作中的一些数据处理问题,望各位指点一二,不胜感激!
本人联系方式:Mail: jg_gao@sae.com.hk / QQ 16963711
[解决办法]
如果只有几兆大小,方案就非常多了
- VB code
Option ExplicitPrivate Declare Function GetTickCount Lib "kernel32.dll" () As LongPrivate Sub Command1_Click() Dim Buff As String, LineBuff() As String, OutBuff() As String Dim I As Long, J As Long Dim lTime As Long lTime = GetTickCount Open "d:\temp\test.txt" For Binary As #1 Buff = Space(LOF(1)) '一次读入内存 Get #1, , Buff Close #1 J = -1 LineBuff() = Split(Buff, vbCrLf) '按行分割 ReDim OutBuff(0) For I = 0 To UBound(LineBuff) '逐行比较是否有重复 If InStr(1, Join(OutBuff(), " "), LineBuff(I), vbTextCompare) = 0 Then J = J + 1 '没有重复,就增加到输出缓冲区 ReDim Preserve OutBuff(J) OutBuff(J) = LineBuff(I) End If Next Open "d:\temp\testout.txt" For Binary As #1 '将输出缓冲区内容写入到文件 Put #1, , Join(OutBuff(), vbCrLf) Close #1 MsgBox GetTickCount - lTime '计算耗时End Sub
[解决办法]
1 文件的删减添加,在实际操作中都是创建新文件。但是可以在写好以后,删除旧文件,将新文件改为旧名。
2 用你的数据做了一个 1.2M 的文件来测试。结果处理时间不到一秒。注意将 LstBox 控件的 Visible 设置为不可见。免得更新界面耽误时间。
Private Declare Function SendMessagebyString Lib _
"user32" Alias "SendMessageA" (ByVal hWND As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As String) As Long
Private Const LB_FINDSTRINGEXACT = &H1A2 '在 ListBox 中精确查找
Private Sub Command1_Click()
Dim strLine As String
Dim i As Long
List1.Clear
Open "c:\test1.txt" For Input As #1
Do Until EOF(1)
Line Input #1, strLine
strLine = Trim(strLine)
If -1 = SendMessagebyString(List1.hWND, LB_FINDSTRINGEXACT, -1, strLine) Then List1.AddItem strLine
Loop
Close #1
Open "c:\test2.txt" For Output As #2
For i = 0 To List1.ListCount - 1
Print #2, List1.List(i)
Next i
Close #2
MsgBox "ok"
End Sub
Private Sub Form_Load()
Dim i As Long
Open "c:\test1.txt" For Output As #1
For i = 1 To 10000
Print #1, "1;2;3;4;5;6;7;8;9;10;11;12 "
Print #1, "1;2;3;4;5;6;7;asda8;9;10;11;12a"
Print #1, "1;2;3;4;5;6;7;8;9;10;11;12"
Print #1, "1;2;3;4;5;6;7;8;9;asdasd10;11;12b"
Next i
Close #1
End Sub
快的原因可能有两个,一是重复记录太多,在 List 中备份的很少。二是我的机器不算太慢。
[解决办法]
这类问题,爱用字典dictionary
引用一下Microsoft Scripting Runtime (Scrrun.dll)
- VB code
Option Explicit'随机生成字符串Private Function GetStrValue() As String Dim i As Long, j As Long, r As Long Dim tmp As String tmp = "1;2;3;4;5;6;7;8;9;0;a;b" Randomize r = Int(Rnd * 12 + 1) For i = 1 To r j = Int(Rnd * 23 + 1) j = j + 1 - (j And 1) Mid(tmp, j, 1) = Chr(Int(Rnd * 75 + 48)) Next GetStrValue = tmpEnd Function'生成一个测试文件Private Sub Form_Load() Dim lngFile As Long Dim strFile As String Dim i As Long, n As Long n = 50000 ReDim arr(n) As String For i = 0 To n arr(i) = GetStrValue Next lngFile = FreeFile Open "d:\tt.txt" For Output As lngFile Print #lngFile, Join(arr, vbCrLf) Close End Sub'删除文件的重复数据Private Sub Command1_Click() Dim lngFile As Long Dim strFile As String Dim arr() As String Dim i As Long, j As Long Dim dic As Dictionary '一次读出文件到strFile lngFile = FreeFile Open "D:\tt.txt" For Binary As lngFile strFile = Space(LOF(lngFile)) Get lngFile, , strFile Close 'strFile内容分组 arr = Split(strFile, vbCrLf) Set dic = New Dictionary For i = 0 To UBound(arr) If Not dic.Exists(arr(i)) Then '用字典判断数据是否重复 dic.Add arr(i), 0 arr(j) = arr(i) '保存有效数据 j = j + 1 End If Next ReDim Preserve arr(j - 1) '写回文件 lngFile = FreeFile Open "d:\ttt.txt" For Output As lngFile Print #lngFile, Join(arr, vbCrLf) Close Set dic = Nothing MsgBox "完成"End Sub
[解决办法]
写完上边的代码后,感觉有点不太理想。 只是获取一个字串的唯一数值,觉得用CRC16有些繁琐了,每个字节要增加8个循环,也就意味着一个10M的文件就要增加1024 * 1024 * (10-1) * 8次循环,开销太大了。就想了,怎么能整体在一个循环中完成这些操作呢? 于是想到了rnd()随机函数, 在随机函数初始值为负数时,能得到一个相同的随机序列。 那么利用随机数产生的值和每行的每个字节进行运算,那么字符串相同的行数产生的数值肯定是一样的。 所以就改进了一下的算法。
直接将文件映射到内存,一次循环全部完成分解。 性能快了一倍还多,在IDE和编译后解析12M文件都在1秒左右。
还有一个很怪异的问题,我改完一个地方后,IDE中运行居然比编译后还快。 有些逗,也有些不理解。
- VB code
Option ExplicitPrivate Type SafeArrayId cDims As Integer fFeatures As Integer cbElements As Long clocks As Long pvData As Long cElemets As Long lBound As LongEnd TypePrivate Declare Function VarPtrArray Lib "msvbvm60" Alias "VarPtr" (ptr() As Any) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal numBytes As Long)Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As LongPrivate Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, ByVal lpFileMappigAttributes As Long, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As LongPrivate Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As LongPrivate Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As LongPrivate Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As LongPrivate Declare Function GetTickCount Lib "kernel32" () As LongPrivate Const PAGE_READWRITE = &H4Private Const FILE_MAP_READ = &H4Private Const FILE_MAP_WRITE = &H2Private Const GENERIC_READ = &H80000000Private Const GENERIC_WRITE = &H40000000Private Const INVALID_HANDLE_VALUE = -1Private Const OPEN_EXISTING = 3Private Const CREATE_ALWAYS = 2Private Const CREATE_NEW = 1Private m_hashColls As CollectionPrivate Function IsExistCode(ByVal lCRC As Long) As Boolean ' ' 利用集合关键字的唯一性,判断该值是否存在 ' On Error GoTo Find_HashCode m_hashColls.Add lCRC, "C" & lCRC IsExistCode = False Exit Function Find_HashCode: IsExistCode = True Err.ClearEnd FunctionPublic Function FilterFile(ByVal strSrcFile As String, ByVal strDestFile As String) As Long Dim hSrcFile As Long Dim hDestFile As Long Dim lpBuffer As Long Dim hMapFile As Long Dim lFileSize As Long Dim nIndex As Long Dim pBytes() As Byte Dim lStart As Long Dim lLength As Long Dim lCrc16 As Long Dim lWriteBytes As Long Dim sa As SafeArrayId FilterFile = False ' 创建一个新的CRC集合 Set m_hashColls = New Collection Do ' ' 打开源文件和目标文件,并将源文件映射到内存区域 ' hSrcFile = CreateFile(strSrcFile, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0) If hSrcFile = INVALID_HANDLE_VALUE Then Exit Do End If hDestFile = CreateFile(strDestFile, GENERIC_WRITE, 0, 0, CREATE_ALWAYS, 0, 0) If (hDestFile = INVALID_HANDLE_VALUE) Then Exit Do End If lFileSize = GetFileSize(hSrcFile, 0) hMapFile = CreateFileMapping(hSrcFile, 0, PAGE_READWRITE, 0, lFileSize, vbNullString) If (hMapFile = 0) Then Exit Do End If lpBuffer = MapViewOfFile(hMapFile, FILE_MAP_READ, 0, 0, lFileSize) If lpBuffer = 0 Then Exit Do End If ' ' 将文件数据映射指针浅度复制构造数组 ' With sa .cDims = 1 .cbElements = 1 .cElemets = lFileSize .fFeatures = &H13 ' FADF_AUTO or FADF_STATIC or FADF_FIXEDSIZE .pvData = lpBuffer End With CopyMemory ByVal VarPtrArray(pBytes), VarPtr(sa), 4 ' ' 遍历数据,按行创建CRC ' 如果CRC不存在集合,则向新文件写入数据 ' nIndex = 0 Dim i As Long Dim lRand As Long While (nIndex < (lFileSize - 1)) lStart = nIndex Rnd -300 lCrc16 = 0 For i = nIndex To lFileSize - 1 lRand = Rnd() * 255 lCrc16 = lCrc16 + (lRand Xor pBytes(i)) If pBytes(i) = &HA And i > 1 Then If pBytes(i - 1) = &HD Then i = i + 1 Exit For End If End If Next 'lCrc16 = lCrc16 Xor &HEFFFFFFF nIndex = i lLength = nIndex - lStart If Not IsExistCode(lCrc16) Then WriteFile hDestFile, ByVal VarPtr(pBytes(lStart)), lLength, lWriteBytes, 0 End If Wend FilterFile = True Loop While (False) ' ' 关闭打开的文件句柄 ' If (lpBuffer <> 0) Then sa.pvData = 0 ' 就是这里,以前没加这句,在IDE中运行得7秒左右,加了这句后IDE运行比编译后还快 UnmapViewOfFile lpBuffer End If If hMapFile <> 0 Then CloseHandle hMapFile End If If (hSrcFile <> INVALID_HANDLE_VALUE) Then CloseHandle hSrcFile End If If (hDestFile <> INVALID_HANDLE_VALUE) Then CloseHandle hDestFile End If End FunctionPrivate Sub Command1_Click() Dim lStart As Long Dim lCount As Long lStart = GetTickCount FilterFile "c:\33.txt", "c:\1234.txt" lCount = GetTickCount - lStart MsgBox lCount End Sub
[解决办法]
- VB code
'用scripting.dictionary的Exists方法(缺点:不能保留空行):set fso = createobject("scripting.filesystemobject")set stream = fso.opentextfile("input.txt",1,false)set dict = createobject("scripting.dictionary")while not stream.atendofstream line = stream.readline if not dict.exists(line) then call dict.add(line,null) end ifwendcall stream.closeset stream = fso.opentextfile("output.txt",2,true)call stream.write(join(dict.keys,vbcrlf))call stream.closecall msgbox("done!")
[解决办法]
- VBScript code
'用scripting.dictionary的Exists方法:set fso = createobject("scripting.filesystemobject")set stream = fso.opentextfile("input.txt",1,false)set stream2 = fso.opentextfile("output.txt",2,true)set dict = createobject("scripting.dictionary")while not stream.atendofstream line = stream.readline if not dict.exists(line) then call dict.add(line,null) call stream2.writeline(line) end ifwendcall stream.closecall stream2.closecall msgbox("done!")
[解决办法]
贴一下使用Collection对象的方法。
- VB code
Dim col As New Collection col.Add 1 col.Add 2 col.Add 1 Dim i As Integer, j As Integer, ColContext As String For i = 1 To col.Count ColContext = ColContext & " " & i & ":" & col.Item(i) Next i MsgBox ColContext '去重复,关键代码。 For i = 1 To col.Count For j = i + 1 To col.Count If col.Item(i) = col.Item(j) Then col.Remove (j) End If Next j Next i ColContext = "" For i = 1 To col.Count ColContext = ColContext & " " & i & ":" & col.Item(i) Next i MsgBox ColContext
[解决办法]
写了一个生成随机文本的小程序,原理是用GUID生成随机序列.
请将以下内容复制到记事本,所有数据行的长度应该都是一样的
如果不一样长的话,请将空格大于号替换为大于号(根据经验,CSDN的论坛会自动在大于号前加空格)
将其保存为out_put_random_file.uue后用winrar即可打开:)
begin 777 output_random_file.rar
M4F%R(1H'`,^0<P``#0````````"M@'0@DD4`R`,``!,+```"L:@,O6^>\CH=
M-2``(````&]U='!U=%]R86YD;VU?9FEL95Q&;W)M,2YF<FT``<`:`/`.)P>G
M&%7N$3UGR<QFZV(@'3C@@;6VE;YQAZI+[\X@HJ05!LY,T6U&RZ3G]<59;NPN
M"Z?A[W((?+361BJ5B7@':9_W<,;AS.D.FD'6*7TT<W\FA[7,>B=K%MU:#\^:
MU28D"@')#F+V;C51=?#5L?>=D5*TKO!H-1,-12K"*;!B)DDD;?;-@1P>=G
MFWI1(:=7!>;'D4+]*P)B:R(O,J&DW*EP6%9`_^G,M^/6KX*;RF`.*$GSE;WV
MVELQY<\3JG=_PDRUE8I%JAXQ/(V%Q@W>K;-(18!]V2FB1%W?:"J:SL!N#BBW
M(P!.#=E>2CKF;RJRU?K;X)X2\)%D[XMM#W?CLQ8\BF%\Q-WY5(L<8^DS153*
M3=E@(T-0S6JNLUZIH\I!&3YB`QP%9!;QH>"5I/P7HZ'V:\X?Z8'A1:H]XBO8
M=EG<UR<?&9`;D"_3`8"7FZ$<8VDI=_5VF"AWO^U)DT60#(]-I<*V"3\,WR+;
MNMM6]RR"\2`TLA5V;/5\&62/N$KS(8MW'=MXI)L!<J<0V>[BMWVQMS`#>P8"
MQ8UVOQ%>:;V5>98RT2QX`4A7J]]*M0/"/Z0[+8(^^W*8K/1AB@AX<VLU.!4;
MO:57`,&$O/M8$KW9"PY62E#6-+9P"?GCWP*7N:4K^6M1Q^TD'Y1P]H#GEW<9
MAL1:7N(&.X["\_63:[V>7_6VPP!1+W<$#>#,)Q\["M^E2P8F@G\+[0S&:&X5
M18B5>[7[+D/[,6&"$/L"FUE_`=J/WA#0IGASK2S+BI&S5MUM78KS@3"9JD'`
MT=WE+>T@X+P%SFSA-ZG.&DSG*FRZ`U[E"40/BUY)ZTX5Z]?F3XL\,D01O-K?
M2'_J"+3!)$O"L$(Y06RTI!<^7AI#%^CO?8>O,T:J'+_*P]D%`ZZ.>^QM\!\7
MQ_W[_RT,S@MS%3*?[@'^);RE#DJKM4/O;WYO+`OT,&X4)PVKOEMVUY"2O".>
MVL$!LP!C&W*"T.O.2WXU-A*>TR#AM"Q>3T[FBFV=.I3%VG(97`-I@TZBY-TT
M6]J^`V-K!,;^&]S4]+CN20H\/QZZ*9C@_X4<FEV)>_.58[CP)%[^9[-:MI??
M*/SE924F&LLMJ<LOEJT73<60HFQ*3HIAXN`^:^.UI%RROV)*-O'8+*?QO8V;
M06KGNE`\Z.KJ8\^A%B`'ZYM.B")J>)=-D5-2,9R1F5>38_YLG8--!+LPK8'T
M5WK^?!4?2;2\MWQ<8=O9Y1:8+JQ75_QCQ1`@%O(8W8`>NR,7HZQ6ZY?\V:W\
M2W)W(.ZC+$="M(KP>64`OXAG]JG_U!D:=""210`<````'`````)CP#J+;Y[R
M.ATP(``@````;W5T<'5T7W)A;F1O;5]F:6QE7$9O<FTQ+F9R>``!P!H`\`XG
M!P,``P`!`#`!`#`!`#`#``,``0!"`@!+0@(`34)Y570@DDX`K0$``&L"```"
MOE&V\(Z>\CH=-2D`(````&]U='!U=%]R86YD;VU?9FEL95RYI+/,,2YV8G``
M7=@1Y0MZ,0`N=F)P`+"P@X4-W13,S/T8$3?0+P=B/3)0+`7\!=%`>B1MJ1@1
MIL5.N:(YH*:\FRXD2@44_A:+QN\#NJ\'O**`I&XTBF2BY()PLCV9[X9[V`\A
M(PX"?9G_P_9@_\,Q;(@M7=8?'X-&/#:7Y6YWY6__8'P.!<LW?+)U?D6XKBLV
M!?,4NVUOTA\JS]/U5K\XJNYM_7)VWF[F#M<R1[(T!#8K[PAXT`3>B!VK@[+M
M3HD0:$:"&*FEQ`SHDBM<E*WDF"W-4UE>GM,2@MCA#:_O[_G^E_6$$4WE2KK1
M>N>(3*(E8^ZE^^9X&%WQZ$F8P/:K*C(66$OE:21J5<1+T[>X1\)TQ)2XEN>=
MIW3E"$4]4-$2K&LU4Q=NE,+L9KRM9%7XKLYJ>(MP75P1;["3\>XMH>E*&%2,
MDD.$YN5$/,LZ?M&>,@:K@.R9J"WS+,;-T0$&G`N98>DTA7H[><,OA3F*U'X#
M:O4AJ#":=2/8=R]C]0?<IUV`\UAIYJWI2TZ9=$*`7,8SFTD9D>+.<!O46GP.
MZ$D(E]\>MNCEU13[)L:W9N>Z^Y4Q'&6,<YU=%1C>]['8KZ+Q1YUU[_K+A70@
MDDX`,@```#(````"4>@,E@>?\CH=,"D`(````&]U='!U=%]R86YD;VU?9FEL
M95RYI+/,,2YV8G<`7=@1Y0MZ,0`N=F)W`/#>.1I&;W)M,2`](#0T+"`U."P@
M-C`S+"`T.#DL(%HL(#(R+"`R.2P@-3@Q+"`T-C`L($,-"DI$=."2.P``````
M``````(`````$Y_R.A0P%@`0````;W5T<'5T7W)A;F1O;5]F:6QE``'`$`#P
,A@YPQ#U[`$`'````
end
