vb 读取 TXT 首先行，并删除第一行

2013-03-14

vb 读取 TXT 第一行，并删除第一行如题：vb 读取 wangzhi.txt 第一行到变量url中，并删除wangzhi.txt第一行

vb 读取 TXT 第一行，并删除第一行
如题：vb 读取 wangzhi.txt 第一行到变量url中，并删除wangzhi.txt第一行的内容，其他行不变。

首先我这个TXT文件有几十M。很多循环每一行的代码都不现实。
希望能有一个高效处理的代码。
[解决办法]
通过richtextbox的 load和savetofile方法速度应该很快
[解决办法]
将这写数据读入一个数组中？
[解决办法]
只有几行代码：

Option Explicit

Private Sub Command1_Click()
    Dim FileNumber As Integer, URL As String, i As Long
    Dim FileByte() As Byte, sFile() As String
    
    FileNumber = FreeFile
    Open "c:\wangzhi.txt" For Binary As #FileNumber
    ReDim FileByte(LOF(FileNumber) - 1)
    Get #FileNumber, , FileByte
    sFile = Split(StrConv(FileByte, vbUnicode), vbCrLf)
    
    URL = sFile(0) '取得文件第一行
    
    Close #FileNumber
    
    
    '将其他行写入文件中
    FileNumber = FreeFile
    Open "c:\wangzhi1.txt" For Binary As #FileNumber
    For i = 1 To UBound(sFile)
        Put #FileNumber, , sFile(i) & vbCrLf
    Next
    Close #FileNumber
    
End Sub

[解决办法]
问题就在于删除第一行。

对一个磁盘文件的修改，实际上是重建一个文件。

Dim strLine1 As String
Dim bytData() As Byte
Dim i As Long, n As Long, lngLength As Long

Open "test.txt" For Input As #1
Line Input #1, strLine1
Close #1

i = LenB(StrConv(strLine1, vbFromUnicode)) + 3

Open "test.txt" For Binary As #1
lngLength = LOF(1) - i
Seek #1, i

Open "new_test.txt" For Binary As #2

Do While lngLength

    If lngLength > 65536 Then
        n = 65536
        lngLength = lngLength - 65536
    Else
        n = lngLength
    End If

    ReDim bytData(n - 1)

    Get #1, , bytData
    Put #2, , bytData

    lngLength = lngLength - n

Loop

Close #2
Close #1

Kill "test.txt"
Name "new_test.txt" As "test.txt"
[解决办法]

楼主，你看仔细了，6 楼的代码是 64K 缓存下的循环（当然，如果你的内存够大，还可以更大）。

另外，你把磁盘文件的读写编辑的原理搞搞清楚，再考虑 shell 还是其他语句。
[解决办法]
要高效就要重新考虑方案：
循环将所有行都处理了，然后直接删除文件。
如果数据是不停增长的，考虑将一个文件分为多个文件 wangzhi001.txt wangzhi002.txt ...
[解决办法]

楼主的需求是明确的，一个几十兆的文件，先读出第一行，然后删除此行。不想用 Line Input 循环读取所有行的方式来生成新文件，因为太慢。

[解决办法]
可以这样考虑：除第一行外，将剩下的字节按照4096的倍数写入新文件。这样应该要快一些，减少了循环次数。
[解决办法]
怎么感觉相似做发送邮件或者扫号的，处理完一个就删除一个。你就每次重新保存吧，速度也慢不了哪去。
[解决办法]

如果楼主所述的过程将对一个文件反复进行的话，这个方案就不大好。似乎更适于采用数据库。
[解决办法]

引用:

只有几行代码：
VB code
Option Explicit

Private Sub Command1_Click()
    Dim FileNumber As Integer, URL As String, i As Long
    Dim FileByte() As Byte, sFile() As String

    FileNumber = FreeFile
  ……

感謝諸先進之答問,今意外找到此檔,與我想要的開發的功能相關(詳見:開發一個較Word全部取代功能更快的方案)

只是我自己寫的程式碼中, ReDim FileByte(LOF(FileNumber) )並不須要減一,"-1"反而出錯.不知5樓chenjl1031先生此式
ReDim FileByte(LOF(FileNumber) - 1)
何故減一?

我的程式碼如下:

Sub open_中文檔_一次讀1個檔案_先讀入陣列_再取代翁方綱3字_多檔多取代值操作_ADO() '比DAO快
 '0.89100000000326秒            43次            43'檔案數
 '0.860000000000582           43            43
 '0.796999999998661           43            43
 '此43個檔案複製5次後(凡215個檔案,97.0 MB (101,752,580 位元組))亦不過6秒鐘
Dim f As String
Dim f2 As String
Dim fa() As Byte
Dim s As Date, e As Date, i As Long, j As Long, g As Long
Dim ss As Date, ee As Date
Dim fdr As String
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset

s = Timer '計時
'取得取代(校對)對照表
cnt.Open "provider=microsoft.jet.oledb.4.0;data source=D:\千慮一得齋\書信\圖書管理\黃沛榮老師助理\!!!新世紀中文詞典\詞典.mdb"
rst.LockType = adLockReadOnly
rst.CursorType = adOpenStatic '速度adOpenForwardOnly>adOpenStatic>adOpenKeyset>adOpenDynamic'前3者差不多!
rst.Open "標楷體漢字總表", cnt '凡20902筆記錄

fdr = "D:\千慮一得齋\書信\圖書管理\黃沛榮老師助理\!!!新世紀中文詞典\程式開發\VBA\Word\新博士論文稿"
f = Dir(fdr & "*") '凡215個檔案
Do Until f = ""
    ss = VBA.Timer
    f = fdr & f
    f2 = Replace(f, "新博士論文稿", "新博士論文稿\test")
    If GetAttr(f) = vbNormal + vbArchive Then
        Open f For Binary As #1 
 
        Open f2 For Binary As #2
        ReDim fa(LOF(1))  '取得檔案長度以設定陣列大小(元素數量)
        '須要減1因為從陣列元素0開始,http://topic.csdn.net/u/20120611/12/565e09c9-4460-46fe-acb0-a2910068ab71.html?70197
        Do While Not EOF(1)
            Get #1, , fa '一次讀1個檔案先讀入陣列
        Loop
            '再取代翁方綱3字為"孫守真"
        With rst
            Do Until .EOF
                '取代unicode標楷體字集為其字之byte值(附註unicode字碼)'<標楷體漢字總表>表中Fields(1)記錄下位元值,Fields(2)記錄上位元值
                If InStr(1, fa, .Fields(0), vbBinaryCompare) Then
                    'fa = Replace(fa, .Fields(0), Format(.Fields(1), "000") & Format(.Fields(2), "000") & "(" & Hex(.Fields(1)) & Hex(.Fields(2)) & ")", , , vbBinaryCompare)
                    fa = Replace(fa, .Fields(0), "1●", , , vbBinaryCompare)
                End If
                g = g + 1
                If g > 500 Then Exit Do
                .MoveNext
            Loop
            .MoveFirst
            g = 0
        End With
        Put #2, , fa
        Reset
        i = i + 1
'        If i = 2 Then '測試各種開啟記錄集的快慢
'            e = Timer: Debug.Print e - s, i, j, rst.CursorType
'            Stop 'test
'        End If
        Debug.Print ee - ss; CInt(FileLen(f) / 1024) & "KB"
    End If
    f = Dir
    j = j + 1
    ee = VBA.Timer
Loop
e = Timer
Debug.Print e - s, i & "檔案", j
End Sub

[解决办法]
要想高效，除非用数据库
------解决方案--------------------

引用:

我这个TXT文件有几十M。很多循环每一行的代码都不现实。
希望能有一个高效处理的代码。

使用api
readfile，writefile，如果删除使用覆盖方式（比如使用空格覆盖），应该很快(类似数据库读写数据)
如果要完全清除估计快不了
[解决办法]
不用循环还是很快的。VB的Get语句本身就有从指定字节处获取字节的功能。
根据这一点，在我的电脑上测试了一个85.3M的文本文件（每行末尾均有一回车换行符），从指定字节处读取以后的所有字节时间是：1.75秒，然后将字节数组整体写入新文件中时间是：6.891秒。已经很快了！我的电脑是：技嘉8irx CPU是：Intel(R) Pentium(R) 4 CPU 1.60GHz，10年前的电脑了。大家可以测试一下！

Option Explicit
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Dim st1 As Long, st2 As Long, et1 As Long, et2 As Long

Private Sub Command1_Click()
    Dim FileNumber As Integer, URL As String, i As Long
    Dim FileByte() As Byte, sFile() As String
    
    FileNumber = FreeFile
    Open "c:\wangzhi.txt" For Binary As #FileNumber
    Line Input #FileNumber, URL '取得文件第一行
    Close #FileNumber
    
    Debug.Print "url=" & URL
    
    i = LenB(StrConv(URL & vbCrLf, vbFromUnicode)) '第一行字节数
    
    '获取第一行以后的其他行，并保存到字节数组FileByte中
    st1 = GetTickCount
    FileNumber = FreeFile
    Open "c:\wangzhi.txt" For Binary As #FileNumber
    Erase FileByte
    ReDim FileByte(LOF(FileNumber) - 1 - i)
    Get #FileNumber, i + 1, FileByte
    Close #FileNumber
    et1 = GetTickCount
    
    
    st2 = GetTickCount
    '将其他行写入文件中
    FileNumber = FreeFile
    Open "c:\wangzhi1.txt" For Binary As #FileNumber
    'For i = 1 To UBound(sFile)
        Put #FileNumber, , FileByte
    'Next
    Close #FileNumber
    et2 = GetTickCount
    
    Debug.Print "读出内容时间：" & (et1 - st1) / 1000 & "秒", "写入内容时间：" & (et2 - st2) / 1000 & "秒"
    
End Sub

热点排行