如何提高文件读写速度？ictest 进来吧。

Option Explicit

Private Sub 连接字符写入()
Dim tttt As Single
    Dim strWj As String
    Dim strJ() As String
    Dim aryContent() As Byte
    Dim tmp() As String
    Dim i As Long
    Dim j As Long
    tttt = Timer
    Open App.Path & "\1.csv" For Binary As #1
        ReDim aryContent(LOF(1) - 1)
        Get #1, , aryContent
    Close #1
    Open App.Path & "\temp.txt" For Output As #2
    strWj = StrConv(aryContent, vbUnicode)
    strJ = Split(strWj, vbCrLf)
    For i = 0 To UBound(strJ)
        If IsNumeric(Left(strJ(i), 1)) = True Then
            tmp() = Split(strJ(i), ",")
                If tmp(2) = "True" Then
                    Print #2, tmp(5) & vbTab & tmp(6) & vbTab & tmp(16) & vbTab & tmp(20) & vbTab & tmp(23) & vbTab & tmp(24)
                End If
        End If
    Next i
    Close #2
Label1.Caption = Timer - tttt

End Sub

Private Sub 使用分号写入操作()
Dim tttt As Single
    Dim strWj As String
    Dim strJ() As String
    Dim aryContent() As Byte
    Dim tmp() As String
    Dim i As Long
    Dim j As Long
   
    tttt = Timer
    Open App.Path & "\1.csv" For Binary As #1
        ReDim aryContent(LOF(1) - 1)
        Get #1, , aryContent
    Close #1
    Open App.Path & "\temp2.txt" For Output As #2
    strWj = StrConv(aryContent, vbUnicode)
    strJ = Split(strWj, vbCrLf)
    For i = 0 To UBound(strJ)
        If IsNumeric(Left(strJ(i), 1)) = True Then
            tmp() = Split(strJ(i), ",")
                If tmp(2) = "True" Then
                    Print #2, tmp(5); vbTab; tmp(6); vbTab; tmp(16); vbTab; tmp(20); vbTab; tmp(23); vbTab; tmp(24)
                End If
        End If
    Next i
    Close #2
   
Label2.Caption = Timer - tttt

   
End Sub

Private Sub 全byte操作()
Dim tttt As Single

    Dim aryContent() As Byte            '原始数组
    Dim lenary As Long                  '原始数据长度
   
    'w1 每行第一个字符
    'w2 每行最后一个字符
    Dim w1 As Long, w2 As Long, w3 As Long
    Dim w4 As Long
   
    Dim nary() As Byte      '新数组
    Dim nw1 As Long         '新数组读写位置，也表示已经有数据长度
   
    tttt = Timer
    Open App.Path & "\1.csv" For Binary As #1
        lenary = LOF(1) - 1
        ReDim aryContent(lenary)
        ReDim nary(lenary)          '初始与原数据一样大
        Get #1, , aryContent
    Close #1

    w1 = 0              '开始位置
    nw1 = 0
    Do
        w2 = FSB(w1, aryContent, 13)          '这一行的数据结束位置
        If w2 = -1 Then w2 = lenary             '如果取数据结束位置失败，则把剩余内容当作一行处理
        If aryContent(w1) > 47 And aryContent(w1) < 58 Then '0-9之间
            w3 = FSD(w1, aryContent(), 1)    '第二个逗号,最后一个参数表示中间要跳过几个逗号
            If w3 > w2 Or w3 = 0 Then GoTo SkipDo       '如果第二个逗号超出本行结束位置，跳掉
            
            w4 = w3                           '第2个逗号后就是第3节
            If aryContent(w4 + 1) = 84 Then   '第3节第一个字符为 T
            
                w4 = FSD(w4 + 1, aryContent(), 2) '第5节,w4 为第2节开始
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 9
                nw1 = nw1 + 1
               
                w4 = FSD(w4 + 1, aryContent(), 0) '第6节
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 9
                nw1 = nw1 + 1
               
                w4 = FSD(w4 + 1, aryContent(), 9) '第16节
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 9
                nw1 = nw1 + 1
               
               
                w4 = FSD(w4 + 1, aryContent(), 3) '第20节
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 9
                nw1 = nw1 + 1
               
                w4 = FSD(w4 + 1, aryContent(), 2) '第23节
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 9
                nw1 = nw1 + 1
               
                w4 = FSD(w4 + 1, aryContent(), 0) '第24节
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 13
                nw1 = nw1 + 1
                nary(nw1) = 10
                nw1 = nw1 + 1
            
            End If
        End If
        
    '这行不处理的统统跳这里
SkipDo:

    w1 = w2 + 2             '处理下一行开始位置
    If w1 > lenary Then Exit Do
    Loop
   
    If nw1 > 1 Then
        nw1 = nw1 - 1
        ReDim Preserve nary(nw1)    '干掉多余内容，如果最后一个回车符不要，就要 nw1-2
        If Dir(App.Path & "\temp3.txt") <> "" Then
            Kill App.Path & "\temp3.txt"
        End If
        Open App.Path & "\temp3.txt" For Binary As #2
            Put #2, , nary
        Close #2
    End If
Label3.Caption = Timer - tttt
'    MsgBox "完成"
   
'MsgBox Timer - tttt
End Sub

Public Function FSB(start As Long, strary() As Byte, ByVal str2 As Byte) As Long '搜索数组
Dim i As Long
Dim o As Long

o = UBound(strary)
For i = start To o
    If strary(i) = str2 Then
        Exit For
    End If
Next i
If i > o Then
    FSB = -1
Else
    FSB = i
End If
End Function

Public Function FSD(start As Long, strary() As Byte, ByVal SkipD As Long) As Long    '查找逗号
Dim i As Long
Dim o As Long
o = UBound(strary)
For i = start To o
    If strary(i) = 44 Then      '找到逗号
        If SkipD <= 0 Then      '不需要再跳过了
            Exit For
        Else                    '否则跳过
            SkipD = SkipD - 1
        End If
    End If
Next i
If i > o Then
    FSD = -1
Else
    FSD = i
End If
End Function

Public Function CopyByte(s1 As Long, ary1() As Byte, S2 As Long, newary() As Byte, ByVal E As Byte) As Long
'返回新数组里下一个准备写入的位置
'如果起始位置超过数组大小，会导致没有数据被复制
Dim i As Long
Dim o As Long
Dim j As Long
j = S2
o = UBound(ary1)
For i = s1 To o
    If ary1(i) = E Then     '找到结束字符
        Exit For
    Else
        newary(j) = ary1(i) '否则复制这个字节
        j = j + 1
    End If
Next i
CopyByte = j

End Function

Private Sub Command1_Click()

Call 连接字符写入
Call 使用分号写入操作
Call 全byte操作
MsgBox "完成"
End Sub