从网上找到如下一段程序，说是对TXT文件在内存中读写，我用一个TXT文件试了试，发现报“实时错误9   下标越界”错误，我分步运行，发现For I = 0 To UBound(StrArr)这一句的UBound(StrArr)值为1，我的txt文件大概有5万行左右，请问这是怎么回事？

另外，请帮看看还有什么地方有问题？


Private Sub Command1_Click()
      Dim FileName As String
      Dim StrArr() As String
      Dim TmpStr() As String
      Dim WritStr As String
      Dim I As Long
      Dim B As Long
       B = 1000
      FileName = "c:\N1.txt"
      '将文件读到一个字符串数组.
      StrArr = RedTextFile(FileName)
      For I = 0 To UBound(StrArr)
      B = B + 1
          TmpStr = Split(StrArr(I), " ")
          '查找符合条件的项
          If UCase$(TmpStr(0)) = "Site" And UCase$(TmpStr(1)) = "1:" Then
             '修改该项
             TmpStr(2) = "P" & B
             StrArr(I) = TmpStr(0) & " " & TmpStr(1) & " " & TmpStr(2)
          End If
          WritStr = WritStr & StrArr(I) & Chr(13)
      Next
      '回写文件
      WritTextFile FileName, WritStr
End Sub

'读TEXT文件
'函数:RedTextFile
'参数:FileName 打开的TXT文件名.
Public Function RedTextFile(FileName As String) As String()
     Dim FileID As Long
     Dim InputStr As String
     Dim LineStr As String
     Dim RevStr() As String
     Dim ID As Long
     
     On Error Resume Next
     
     InputStr = "": LineStr = ""
     FileID = FreeFile()
     Open FileName For Input As #FileID
          Do While Not EOF(FileID)           ' 循环至文件尾。
             LineStr = ""
             ID = ID + 1
             ReDim Preserve RevStr(ID)
             Line Input #FileID, LineStr
             RevStr(ID - 1) = LineStr
          Loop
     Close #FileID
     RedTextFile = RevStr
     Err.Clear
End Function

'写TEXT文件
'函数:WritTextFile
'参数:FileName 目标文件名.WritStr 写到目标的字符串.
'返回值:成功 返回文件内容.失败  返回""
'注:如果同名,目标字符串将覆盖原文件内容.
Public Function WritTextFile(FileName As String, WritStr As String) As Boolean
'/保存文件
    Dim FileID As Long, ConTents As String
    Dim A As Long, B As Long
   
    On Error Resume Next
   
    FileID = FreeFile
    Open FileName For Output As #FileID
         Print #FileID, WritStr
    Close #FileID
    WritTextFile = (Err.Number = 0)
    Err.Clear
End Function

代码看上去好像是没有问题
我随便找了一个文档测试，进入For I = 0 To UBound(StrArr)循环的时候是正常的，UBound(StrArr)也是对的。 至于你提到的

你说的5万行我怀疑是自动换行的情况，VB读取的时候行是以换行符也就是回车符划分的，其实是段。一段不管你自动换行多少行，他都是一行。
另外，这个不应该是下标越界错误的原因。

我的也报错“实时错误9   下标越界”，但是因为下面的语句

          TmpStr = Split(StrArr(I), " ")                    '这里按照" "进行拆分，我的文档中没有中间的空格，导致无法拆分出  TmpStr(0)~TmpStr(2) 这几个项。 检查一下你的文本是不是也这样？？
          '查找符合条件的项
          If UCase$(TmpStr(0)) = "Site" And UCase$(TmpStr(1)) = "1:" Then
             '修改该项
             TmpStr(2) = "P" & B
             StrArr(I) = TmpStr(0) & " " & TmpStr(1) & " " & TmpStr(2)
          End If
          WritStr = WritStr & StrArr(I) & Chr(13)

我检查了一下TXT文件，您说的对，这个TXT文件是UNIX格式的TXT（只有换行，没有回车），不是DOS格式的TXT（有回车，有换行），所以读出来的是所有内容一整行；
当我将这个文件用UltraEdit转换格式后，当读到空行时， If UCase$(TmpStr(0)) = "Site" And UCase$(TmpStr(1)) = "1:" Then 会报 实时错误9   下标越界。
先将程序修改如下，“实时错误9   下标越界”就不会再报了（先把这个文件用UltraEdit转换格式）：

Private Sub Command1_Click()
      Dim FileName As String
      Dim StrArr() As String
      Dim TmpStr() As String
      Dim WritStr As String
      Dim i As Long
      Dim b As Long
       b = 1000
       tt = Timer
      FileName = "c:\merge_dos2.txt"
      '将文件读到一个字符串数组.
      StrArr = RedTextFile(FileName)
      For i = 0 To UBound(StrArr)

          '查找符合条件的项
      If InStr(StrArr(i), "Site 1: P") <> 0 And Len(StrArr(i)) < 15 Then
      b = b + 1
          StrArr(i) = "Site 1: P" & b
      End If
          WritStr = WritStr & StrArr(i) & vbCrLf
      Next
      '回写文件
      WritTextFile FileName, WritStr
      tt = Timer - tt
      MsgBox "OK" & "    " & tt
End Sub

'读TEXT文件
'函数:RedTextFile
'参数:FileName 打开的TXT文件名.
Public Function RedTextFile(FileName As String) As String()
     Dim FileID As Long
     Dim InputStr As String
     Dim LineStr As String
     Dim RevStr() As String
     Dim ID As Long
     
     On Error Resume Next
     
     InputStr = "": LineStr = Chr(13)
     FileID = FreeFile()
     Open FileName For Input As #FileID
          Do While Not EOF(FileID)           ' 循环至文件尾。
            LineStr = ""
             ReDim Preserve RevStr(ID)
             Line Input #FileID, LineStr
             ID = ID + 1
             RevStr(ID - 1) = LineStr
          Loop
     Close #FileID
     RedTextFile = RevStr
     Err.Clear
End Function

'写TEXT文件
'函数:WritTextFile
'参数:FileName 目标文件名.WritStr 写到目标的字符串.
'返回值:成功 返回文件内容.失败  返回""
'注:如果同名,目标字符串将覆盖原文件内容.
Public Function WritTextFile(FileName As String, WritStr As String) As Boolean
'/保存文件
    Dim FileID As Long, ConTents As String
    Dim A As Long, b As Long
    
    On Error Resume Next
    
    FileID = FreeFile
    Open FileName For Output As #FileID
         Print #FileID, WritStr
    Close #FileID
    WritTextFile = (Err.Number = 0)
    Err.Clear
End Function

我现在有个问题：
这段程序运行还是太慢，5万多行，查找并替换需要130秒以上，如何修改才能更快些呢？

挺好，自己修改。
你说的运行慢这个问题，因为你是读取，再写入。还有可能电脑和系统的问题。 如果还要快一些的话，我一时想不到如何处理