优化Sub 执行dos并读取txtApplicationScreenUpdating = FalseP = CreateObjectWScriptShellSpecialFoldersDesktop 桌面文件3 = P & 读取文本txt读取文件Open 文件3 For Input As #1Lines = SplitStrConvInputBLOF1 1 vbUnicode vbCrLfClos

优化的代码如下：

Sub 执行dos并读取txt() Application.ScreenUpdating = False Dim P As String Dim 文件3 As String Dim Lines() As String Dim k As Integer Dim cols() As String Dim q As Integer Dim i As Integer Dim j As Integer

P = CreateObject("WScript.Shell").SpecialFolders("Desktop") '桌面
文件3 = P & "\读取文本.txt"

'读取文件
Open 文件3 For Input As #1
Lines = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Close #1

k = UBound(Lines) + 1 '文件的行数

'遍历每一行
For i = 1 To k
    cols = Split(Lines(i - 1), ",") '以逗号作为分隔，将每行字符分割，分隔符可根据实际情况自己修改
    q = UBound(cols) + 1 '分隔成的列数
    For j = 1 To q '遍历该行的每一列
        Worksheets("Sheet1").Cells(i, j) = cols(j - 1) '输出到表格中
    Next j
Next i

MsgBox ("文件" & file_name & "读取完成,共" & k & "行")
Application.ScreenUpdating = True '运行结束

End Sub