7,785
社区成员




Option Explicit
Private Sub Command1_Click()
Const SEPSTR As String = ""","""
Dim strRlt() As String
Dim strTemp As String
Dim dTime As Double
Dim lNum As Long
Dim iFn As Integer
Dim i&, p&, ps&, pe&
iFn = FreeFile()
dTime = Timer()
Open "E:\Tools\2.txt" For Input As #iFn
Line Input #iFn, strTemp
lNum = LOF(iFn) / Seek(iFn)
ReDim strRlt(lNum)
p = -1&: Seek iFn, 1
Do
If (EOF(iFn)) Then Exit Do
p = p + 1&
If (p > lNum) Then
lNum = lNum + 160
ReDim Preserve strRlt(lNum)
End If
Line Input #iFn, strTemp
i = InStr(20, strTemp, "/")
ps = InStr(i + 12, strTemp, SEPSTR) + 3
pe = InStr(ps, strTemp, SEPSTR)
strRlt(p) = Mid$(strTemp, ps, pe - ps)
Loop
Close
Me.Print "耗时:" & Format$(Timer() - dTime, "0.00秒")
Me.Print "提取数据:" & p + 1
' 结果检查:
pe = -1&
For i = 0 To p
ps = Len(strRlt(i))
If (ps <> 15& And ps <> 18&) Then
Me.Print i + 1; "出错"
pe = 0
End If
Next
If (pe) Then Me.Print "数据检验合格。"
End Sub
楼主提供给我的样本文件 3.83MB,共15456条数据,
我复制5倍, 共19.1MB、77280条数据。
在我的一台配置比较差的办公电脑上,全部处理完仅1秒钟。
单读取文件,约0.9秒。
Function GetID(sLine As String) As String
Dim lLength As Long
Dim i1 As Long '字段开始位置
Dim i2 As Long '字段结束的逗号位置
Dim s As String
lLength = Len(sLine)
If lLength = 0 Then Exit Function
i1 = 1
While i1 <= lLength
i2 = InStr(i1, sLine, ",")
If i2 = 0 Then i2 = lLength + 1
If (i2 - i1) <= 2 Then GoTo NextField
If Mid$(sLine, i1, 1) <> """" Then GoTo NextField
If Mid$(sLine, i2 - 1, 1) <> """" Then GoTo NextField
Select Case (i2 - i1 - 2)
Case 15
s = Mid$(sLine, i1 + 1, 15)
If s Like "###############" Then
GetID = s
Exit Function
End If
Case 18
s = Mid$(sLine, i1 + 1, 18)
If s Like "#################[0-9X]" Then
GetID = s
Exit Function
End If
End Select
NextField:
i1 = i2 + 1
Wend
End Function