数据快速删除求教高手，谢谢！！！

Question

数据快速删除求教高手，谢谢！！！下面这段代码删除1000个（每个文件只有13K）文件内的某一天（qusjcx.RQ）数据，用了2分多种，求教缩短时间的方法，谢谢！！！Private Sub XPButton5_Click()
Dim i, p, kk, HELL As Long
Dim qusjcx As QLDDEXX
Dim qusjcxnew As QLDDEXX
XPProgressBar1.min = 0
XPProgressBar1.Max = List2.ListCount
For kk = 0 To List2.ListCount - 1
 DoEvents
    If Dir(App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY") <> "" Then
       Open App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY" For Binary Access Read As #1
            For HELL = 0 To (LOF(1) / Len(qusjcx)) - 1
            Get #1, , qusjcx
            If qusjcx.RQ <> Format(DT1, "yyyymmdd") Then
               Open App.Path & "\QLD\" & Val(List2.List(kk)) & ".TEMP" For Binary Access Read Write As #2
               If LOF(2) / Len(qusjcxnew) = 0 Then
               qusjcxnew.RQ = qusjcx.RQ
               qusjcxnew.kpj = qusjcx.kpj
               qusjcxnew.zgj = qusjcx.zgj
               qusjcxnew.zdj = qusjcx.zdj
               qusjcxnew.spj = qusjcx.spj
               qusjcxnew.cjl = qusjcx.cjl
               qusjcxnew.cje = qusjcx.cje
               qusjcxnew.ZF = qusjcx.ZF
               Put #2, , qusjcxnew
               Else
               Seek #2, LOF(2) + 1
               qusjcxnew.RQ = qusjcx.RQ
               qusjcxnew.kpj = qusjcx.kpj
               qusjcxnew.zgj = qusjcx.zgj
               qusjcxnew.zdj = qusjcx.zdj
               qusjcxnew.spj = qusjcx.spj
               qusjcxnew.cjl = qusjcx.cjl
               qusjcxnew.cje = qusjcx.cje
               qusjcxnew.ZF = qusjcx.ZF
               Put #2, , qusjcxnew
               End If
               Close #2
            End If
          Next
     Close 1#
     KILL App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY"
     Name App.Path & "\QLD\" & Val(List2.List(kk)) & ".TEMP" As App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY"
     End If
     XPProgressBar1.Value = kk
    Next
End Sub

Answer 1

If qusjcx.RQ <> Format(DT1, "yyyymmdd") Then 
----------------------------------------------------
这里可以稍微优化一下，没必要执行1000*N次“Format(DT1, "yyyymmdd")”
可以在循环外面定义一个变量s，s=Format(DT1, "yyyymmdd")
然后改成If qusjcx.RQ <> s Then 不会提高多少性能，大概0.1-2秒而已
呵呵

Answer 2

谢谢！！！
求教yachong ：（数据是按照时间排序的）
用二分法如何做，帮忙写一下好吗，谢谢！！！

Answer 3

Dim i, p, kk, HELL As Long
Dim qusjcx As QLDDEXX
Dim qusjcxnew As QLDDEXX
Dim strName()     As Byte
Dim strPath()     As Byte
XPProgressBar1.min = 0
XPProgressBar1.Max = List2.ListCount
For kk = 0 To List2.ListCount - 1
 DoEvents
    If Dir(App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY") <> "" Then
       p = 0
       Open App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY" For Binary Access Read As #1
            i = (LOF(1) / Len(qusjcx)) - 1
            For HELL = 0 To (LOF(1) / Len(qusjcx)) - 1
            Get #1, , qusjcx
            
            If qusjcx.RQ = Format(DT1, "yyyymmdd") Then
               p = HELL
               Text1 = qusjcx.RQ
               Exit For
               End If
          Next
          If p > 0 Then
          ReDim strName(Len(qusjcx) * (p - 1))
          ReDim strPath(Len(qusjcx) * (i - p))
          Seek #1, 1
          Get #1, , strName
          Seek #1, Len(qusjcx) * p
          Get #1, , strPath
          End If
     Close 1#
     Open App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY" For Binary As #1
     Put #1, , strName
     Put #1, , strPath
     Close #1
     End If
     XPProgressBar1.Value = kk
    Next求教：我把小于指定日期的数据度如数组strName，把大于指定日期的数据度如数组strPath，在把两个数组内容写入文件（删除原文件内容），可出错了，还请高手帮助看看错在那里，谢谢！！！

Answer 4

Dim i, p, kk, HELL As Long
Dim qusjcx As QLDDEXX
Dim qusjcxnew As QLDDEXX
Dim namenew() As String
Dim strName()     As Byte
Dim strPath()     As Byte
XPProgressBar1.min = 0
XPProgressBar1.Max = List2.ListCount
For kk = 0 To List2.ListCount - 1
 DoEvents
    If Dir(App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY") <> "" Then
       p = 0
       Erase strName
       Erase strPath
       Open App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY" For Binary Access Read As #1
            i = (LOF(1) / Len(qusjcx)) - 1
            For HELL = 0 To (LOF(1) / Len(qusjcx)) - 1
            Get #1, , qusjcx
            If qusjcx.RQ = Format(DT1, "yyyymmdd") Then
               p = HELL
               Text1 = qusjcx.RQ
               Exit For
               End If
          Next
          If p > 0 Then
          ReDim strName(Len(qusjcx) * (p))
          ReDim strPath(Len(qusjcx) * (i - p))
          Get #1, 1, strName
          Get #1, Len(qusjcx) * (p + 1), strPath
          End If
     Close 1#
     If p <> 0 Then
     KILL App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY"
     Open App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY" For Binary Access Write As #1
     Put #1, 1, strName
     Put #1, Len(qusjcx) * (p), strPath
     Close #1
     End If
     End If
     
     XPProgressBar1.Value = kk
    Next请教高手：KILL App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY"这句影响了速度，我该如何提高运行速度如KILL App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY"去掉，在新文件中，则不能把原文件内数据完全山除掉，还请搞首相助，谢谢！！！

Answer 5

Private Sub XPButton5_Click()
    Dim i, p, kk, HELL As Long
    Dim qusjcx As QLDDEXX
    Dim qusjcxnew As QLDDEXX
    XPProgressBar1.Min = 0
    XPProgressBar1.Max = List2.ListCount
    
    Dim sRQ As String
    sRQ = Format(DT1, "yyyymmdd")
    
    For kk = 0 To List2.ListCount - 1
        DoEvents
        
        Dim sDataFile As String, sTempFile As String
        sDataFile = App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY"
        sTempFile = App.Path & "\QLD\" & Val(List2.List(kk)) & ".TEMP"
        
        If Dir(sDataFile) <> "" Then
            Open sDataFile For Binary Access Read As #1
            If Dir(sTempFile) <> "" Then Kill sTempFile
            Open sTempFile For Binary Access Write As #2
            
            While Not EOF(1)
                Get #1, , qusjcx
                If qusjcx.RQ <> sRQ Then
                    qusjcxnew.RQ = qusjcx.RQ
                    qusjcxnew.kpj = qusjcx.kpj
                    qusjcxnew.zgj = qusjcx.zgj
                    qusjcxnew.zdj = qusjcx.zdj
                    qusjcxnew.spj = qusjcx.spj
                    qusjcxnew.cjl = qusjcx.cjl
                    qusjcxnew.cje = qusjcx.cje
                    qusjcxnew.ZF = qusjcx.ZF
                    Put #2, , qusjcxnew
                End If
            Next
            
            Close 1#
            Close 2#
            Kill sDataFile
            Name sTempFile As sDataFile
        End If
        
        XPProgressBar1.Value = kk
    Next
End Sub

Answer 6

谢谢Tiger_Zhao ！！！请帮助看一下下面的代码：
在执行Open App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY" For Binary Access Write As #1 时，如
App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY"文件就存在，求其中有数据，就会覆盖原来旧数据，但如新的数据比原旧数据少，则不能完全覆盖掉，我想实现在新的数据比原旧数据少，写入后完全覆盖原数据，而不用KILL App.Path & "\QLD\" & Val(List2.List(kk)) & ".DAY" ，可有办法，谢谢！！！

Answer 7

下面是 API-Guide 的例子你可以参考一下，用 SetFilePointer 指定指针位置，SetEndOfFile 就在此处将文件截短。
'Example by Skuratovich Pavel aka P@Ssword ([email protected])
'It is an example of use of function SetEndOfFile.
Option ExplicitPrivate Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_ALWAYS = 4
Private Const FILE_BEGIN = 0Private Sub Form_Load()
Dim hFile As Long
Dim BytesWritten As Long
Dim Path As String    Path = "C:\EOF.txt"    hFile = CreateFile(Path, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_ALWAYS, 0, 0)
    If hFile = -1 Then End
    WriteFile hFile, ByVal "Very-very cool & long string", 28, BytesWritten, ByVal 0&
    MsgBox "View file 'C:\EOF.txt', then click OK"
    SetFilePointer hFile, 9, 0, FILE_BEGIN
    SetEndOfFile hFile
    CloseHandle hFile
    MsgBox "Now view file '" & Path & "' one more time"
    Unload Me
End Sub

Answer 8

因为数据不多,建议别用QLD\" & Val(List2.List(kk)) & ".TEMPl临时文件全在内存进行操作即可