如何提高文件读写速度?ictest 进来吧。
接着 https://bbs.bccn.net/thread-500464-1-1.html 贴子。
思考了一下,然后动手写一截子代码,然后差点放弃了。。VB对于 BYTE数组,查找,分割等等 ,都没有函数支持,都需要自己写。代码好复杂。
在窗体上再放 Label1、Label2、Label3 三个控件显示三个时间。
我测试的结果依次为:
IDE:3.249375、3.218375、2.030875
编译后:3.20275、3.296875、0.343625
程序代码:
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
[此贴子已经被作者于2020-3-22 12:46编辑过]