关于文件读取、写入、排序的问题

[xmzorro]

有个文件长度大概有十万行，每行都是一组数字。如何将这个文件里相同的数字写到另一个文件？并对原文件进行排序？

[bobdog1215]

都不说是什么格式的文件 ...

[fxy_2002]

可以考虑将它们全部读入一个表中（access or ms sql)，然后使用 sql 语句进行过滤和排序，这样应该比较快。

[winehero]

建议将数据读取到数据库表中（比如说Access MDB的一个表中），于是：

相同的数字写到另一个文件
————————————————
使用类似SQL：select 字串字段 from 表 group by 字串字段 having count(字串字段)>1
得到相同的数据的记录集，使用记录集的Save方法保存成文本

并对原文件进行排序？
_________________________
使用SQL：select distinct 字串字段 from 表 order by 字串字段就可将已排序的Recordset
使用Save方法保存成排序了的文本文件。

[feiyun0112]

导到数据库操作

[xmzorro]

是TXT文件

[xmzorro]

不想用数据库了，不然用EX不就OK了。就想容易点。速度快点。

[舍南舍北]

Private Sub cmdSplitFile_Click()
sFile = ReadFile(CommonDialog1.FileName)
end sub
快速读txt文件的模块
Option Explicit

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA _
) As Long
Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long _
) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, _
lpSystemTime As SYSTEMTIME _
) As Long
'
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
'
Type FILETIME
LowDateTime As Long
HighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260 'MUST be set to 260
cAlternate As String * 14
End Type
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
'
Public Function Findfile(ByVal xstrfilename As String) As WIN32_FIND_DATA
On Error GoTo ErrorHandler

Dim Win32Data As WIN32_FIND_DATA
Dim plngFirstFileHwnd As Long
Dim plngRtn As Long

plngFirstFileHwnd = FindFirstFile(xstrfilename, Win32Data) ' Get information of file using API call
If plngFirstFileHwnd = 0 Then
Findfile.cFileName = "Error" ' If file was not found, return error as name
Else
Findfile = Win32Data ' Else return results
End If
plngRtn = FindClose(plngFirstFileHwnd) ' It is important that you close the handle for FindFirstFile

Exit Function 'Sub
ErrorHandler: ' 'On Error GoTo ErrorHandler
Dim funName
funName = "Findfile"

' Call WriteRunErrInfo(funName, Err.Number, Err.Description)
End Function

Public Function ReadFile(ByVal FileAllPath As String) As String
' Dim i As Long

'FileAllPath = "d:\sb$\test.txt"

'get file size
Dim filedata As WIN32_FIND_DATA
Dim nFileSize As Long

filedata = Findfile(FileAllPath) ' Get file information
If filedata.nFileSizeHigh = 0 Then '
nFileSize = filedata.nFileSizeLow '& " Bytes"
Else
nFileSize = filedata.nFileSizeHigh '& "Bytes"
End If

If nFileSize <= 0 Then '(error 61)

Exit Function
End If

'read file:
Dim bytBuffer() As Byte
ReDim bytBuffer(nFileSize - 1)

Dim nFileNum As Integer
nFileNum = FreeFile
Open FileAllPath For Binary As #nFileNum
Get #nFileNum, , bytBuffer()
Close #nFileNum

Dim sTeleText As String
sTeleText = StrConv(bytBuffer(), vbUnicode)

ReadFile = sTeleText

End Function

[bobdog1215]

Dim data As String
Open "d:\11.txt" For Input As #1
Open "d:\22.txt" For Output As #2
Do While Not EOF(1)
Line Input #1, data
Print #2, date '这里对data按需求处理
Loop
Close #2
Close #1

[xmzorro]

TO：(林夕)两行字段怎么比较？怎么按顺序写入另一个TXT文件？

[weiweiplay]

Private Sub Form_Load()
Dim fNum As Integer
Dim Col1 As New Collection
Dim Col2 As New Collection
Dim Col3 As New Collection
Dim FileName As String
Dim lLen As Long
Dim Index As Long
Dim i As Long, j As Long
Dim str As String

FileName = App.Path & "\1.txt"

fNum = FreeFile
Open FileName For Input As fNum
Do While Not EOF(fNum)
Line Input #fNum, str
Col1.Add str
Loop
Close #fNum

'----------------------------------------------------------排序开始
Do While Col1.Count > 0
Index = 1
str = Col1.Item(Index)
For i = Index + 1 To Col1.Count
If StrComp(Col1.Item(i), str, vbTextCompare) = -1 Then
str = Col1.Item(i)
Index = i
End If
Next i
Col2.Add Col1.Item(Index)
Col1.Remove Index
Loop

For i = 1 To Col2.Count
Debug.Print Col2.Item(i)
Next i

FileName = App.Path & "\2.txt"
Open FileName For Output As fNum
For i = 1 To Col2.Count
Print #fNum, Col2.Item(i) & vbCr
Next i
Close #fNum
'----------------------------------------------------------排序结束

'--------------------------------------------------------剔除相同开始
For i = 1 To Col2.Count
For j = 1 To Col3.Count
If Col2.Item(i) = Col3.Item(j) Then
Exit For
End If
Next j
If j > Col3.Count Then Col3.Add Col2.Item(i)
Next i

FileName = App.Path & "\3.txt"
Open FileName For Output As fNum
For i = 1 To Col3.Count
Print #fNum, Col3.Item(i) & vbCr
Next i
Close #fNum
'----------------------------------------------------------剔除相同结束

End Sub

[DengXingJie]

用SQL语句直接操作txt文件
语法：
Dim Cn As New ADODB.Connection
Cn.ConnectionString = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=C:\TEST;Extensions=asc,csv,tab,txt;"
Cn.Open
Dim Rst As New ADODB.Recordset
Dim Sql As String
Sql = "select * from file.txt"
Rst.CursorLocation = adUseClient
Rst.Open Sql, Cn, adOpenStatic, adLockPessimistic
它会以第一行为字段名来显示，所以在RST中就会少了第一行的记录，如有可能，在第一行加入一说明性的文字，最好是英文的fieldname
那就可以如此下SQL语句：
　　sql="select fieldname count(*) as rec from file.txt group by fieldname having count(*)>1
这样就可以找出所有有重复记录的行

[xmzorro]

weiweiplay(虚幻) ，你的代码调试过吗？我正在看。

[xmzorro]

TO：DengXingJie(杰西) SQL进行查询的速度比LINE　INPUT的速度是快，还是慢？

[weiweiplay]

调试正常

[DengXingJie]

行数比较少的话是难以体现的
行数多的话呢？
你自己试试^_^

[of123]

把文本文件当作数据库来处理。不必另外建数据库。

在文本文件的头一行插入文字“data”，作为字段名，以便引用它来排序。

引用 Microsoft DAO 3.6 Object Library

Dim db As DAO.Database, rs As DAO.Recordset

Set db = Opendatabase("C:\data",False,False,"Text;HDR=Yes;table=" & "C:\data\1.txt")
Set rs = db.OpenRecordset("select * from [1.txt] order by data")
Open "C:\data\2.txt" For Output As #1
Do Until rs.EOF
Print #1, rs!data
rs.MoveNext
Loop
Close #1
rs.close
Set rs = Nothing
db.Close
Set db = Nothing