如何提高文件读写速度？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编辑过]
