Excel VBA从Txt文件中提取指定的开始和长度

我有一个Excel 2007的代码，运行没有失败。

1. 但是它非常缓慢 – 使我的电脑在1-2分钟内无响应。
2. 这些文件大约有14,000 kb，所以不会太大。

如果可能的话，我希望有人告诉我，我能做些什么来使它运行，而不会导致我的电脑挂起。 提前致谢。

Sub ReadFileIntoExcel() Dim fPath As String Const fsoForReading = 1 Dim readlength As Integer Dim readstart As Integer readlength = Worksheets("READFILE").Cells(1, "E").Value readstart = Worksheets("READFILE").Cells(1, "D").Value fPath = Worksheets("READFILE").Cells(1, "C").Value Dim objFSO As Object Dim objTextStream As Object, txt, allread, rw Set objFSO = CreateObject("scripting.filesystemobject") If objFSO.FileExists(fPath) Then Set objTextStream = objFSO.OpenTextFile(fPath, fsoForReading) rw = 1 Do Until objTextStream.AtEndOfStream txt = objTextStream.ReadLine allread = Trim(Mid(txt, readstart, readlength)) With ActiveWorkbook.Sheets("READFILE").Cells(rw, 7).Resize(1, 1) .NumberFormat = "@" 'format cells as text .Value = Array(allread) End With rw = rw + 1 Loop objTextStream.Close Set objTextStream = Nothing Set objFSO = Nothing Exit Sub 

Answer 1

我更新了你的代码，使用一个数组而不是单元格写入，并立即运行

优化

1. 避免单元格范围循环，尤其是逐个单元格写入。 使用数组来代替。 这是最大的一个
2. Resize(1,1)不做任何事情，因为它将单元格保持为单个单元格
3. Long比Integer更有效率
4. 使用string函数Mid$而不是他们较慢的变体替代品Mid
5. allreadvariablesvariables是一个不必要的中间步骤
6. 使用对象的variables名（例如工作表的ws ）可以防止更长的引用

码

 Sub ReadFileIntoExcel() Dim fPath As String Dim ws As Worksheet Const fsoForReading = 1 Dim readlength As Long Dim readstart As Long Dim rw as Long Dim X() Set ws = Worksheets("READFILE") readlength = ws.Cells(1, "E").Value readstart = ws.Cells(1, "D").Value fPath = ws.Cells(1, "C").Value Dim objFSO As Object Dim objTextStream As Object Set objFSO = CreateObject("scripting.filesystemobject") If objFSO.FileExists(fPath) Then Set objTextStream = objFSO.OpenTextFile(fPath, fsoForReading) rw = 1 ReDim X(1 To 1, 1 To 1000) Do Until objTextStream.AtEndOfStream txt = objTextStream.ReadLine If rw Mod 1000 = 0 Then ReDim Preserve X(1 To 1, 1 To UBound(X, 2) + 1000) X(1, rw) = Trim$(Mid$(txt, readstart, readlength)) rw = rw + 1 Loop ws.[G1].Resize(UBound(X, 2), 1) = Application.Transpose(X) ws.Columns("G").NumberFormat = "@" objTextStream.Close Set objTextStream = Nothing Set objFSO = Nothing Exit Sub End If End Sub 

Answer 2

在单元更新时，您可以尝试closures屏幕更新。 如果你触摸了很多细胞，这肯定会加快速度。

 Application.ScreenUpdating = False ...update cells... Application.ScreenUpdating = True 

还有其他一些你可以做的事情，比如closures计算，但是听起来不像你有公式试图评估你的设置。