Question

列“A”：tex文件名列表
列“B”：文本文件中应包含多少行
列“C”：实际上文本文件中有多少行
E1：源路径
E2：限制器，如果文本文件的RowInSummary编号等于或小于E2，则会计算文本文件行

我的脚本计算每个文件的行数。但是如果我将限制器设置得太高（例如500.000或1M）或者文件太多，则脚本不会计算每个文件的行数，因为程序内存不足。（限制器没有必要，我把它称为“内存耗尽”问题，原本我不想用它。）

Sub counter()
    Dim fso As New FileSystemObject
    Dim ts As TextStream
    Dim longtext As String
    Dim lines As Variant
    Dim GoToNum As Integer
    Dim Start As Integer
    GoToNum = 2
    Start = 3

    Do Until IsEmpty(Cells(Start, 1))
        GoToNum = GoToNum + 1
        Start = Start + 1
    Loop

    For i = 3 To GoToNum

        If Cells(i, 2).Value <= Cells(2, 5).Value Then

            ConOrg = Cells(1, 4).Value & "\" & Cells(i, 1).Value

            Set ts = fso.OpenTextFile(ConOrg, ForReading, False)
            longtext = ts.ReadAll

            ts.Close
            lines = Split(longtext, vbLf)
            Cells(i, 3) = UBound(lines) - LBound(lines) - 1

        End If

    Next i

End Sub

脚本如何计算每个文件的行而没有“内存不足”？

Answer 1

以下是如何避免fso并仍然按照自己的意愿行事的示例。

   Sub LinesCounter()

    Dim Path As String
    Dim FileName As String
    Dim SomeText As String
    Dim TextLine As String
    Dim LineCounter As Long
    Dim i As Long
    Dim GoToNum, Start As Long

    Path = Cells(1, 5).Value
    Start = 3

    Do Until IsEmpty(Cells(Start, 1))
        GoToNum = GoToNum + 1
        Start = Start + 1
    Loop

    For i = 3 To GoToNum
            FileName = Cells(i, 1).Value

            Open Path & FileName For Input As #1
                Do Until EOF(1)
                    Line Input #1, TextLine
                    'SomeText = SomeText & " " & TextLine
                    LineCounter = LineCounter + 1
                Loop
            Close #1
            'you can comment line below, it's only for testing
            Debug.Print "There is a: " & LineCounter & " lines in " & _
            FileName & " text file."

            'Adding values to Excel sheet
            Cells(i, 3) = LineCounter
    Next i
    End Sub

“内存不足”会停止行计数器

1 个答案: