改进/优化Excel宏以在文本报告的文件夹中搜索文本短语-Java 学习之路

使用Microsoft Excel 2010，此宏将搜索文本报告文件夹中的短语列表 . 对于每个短语，它会搜索所有报告并列出包含该短语的每个报告 .

我发现了一些更好的宏来完成宏的每个部分 - 例如枚举目录或在文本文件中查找短语 - 尽管我很难将它们成功地组合在一起 . 尽管它不完美，但对于遇到同样问题的其他人可能会有所帮助，我希望能就如何改进和优化宏提供一些反馈 .

基本概述：

A列：文本报告的完整路径列表（例如，"C:\path\to\report.txt"）
B列：报告名称（例如"report.txt"）
C列：要搜索的短语列表
列D：输出显示包含短语的每个报告（C列）

需要改进的方面：

让宏运行得更快！（360个报告和1100个短语花了一个多小时）
从弹出窗口或其他功能中选择报告和报告文件夹（当前使用其他宏输入电子表格）
按文件名过滤报告（例如，仅检查文件名中包含单词或短语的报告）
按文件扩展名过滤报告（例如，仅检查.txt文件而非.xlsx文件）
检测报告和短语的数量（目前这是硬编码的）
其他建议/需要改进的地方

码：

Sub findStringMacro()

Dim fn As String
Dim lineString As String
Dim fileName As String
Dim searchTerm As String
Dim findCount As Integer
Dim i As Integer
Dim j As Integer

For i = 2 To 1109
searchTerm = Range("C" & i).Value
findCount = 0
    For j = 2 To 367
    fn = Range("A" & j).Value
    fileName = Range("B" & j).Value
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(fn)
        Do While Not .AtEndOfStream
            lineString = .ReadLine
            If InStr(1, lineString, searchTerm, vbTextCompare) Then
                findCount = findCount + 1
                Cells(i, 3 + findCount) = fileName
                GoTo EarlyExit
            End If
        Loop
EarlyExit:
        .Close        
    End With
    Next j    
Next i
End Sub

1 回答

正如@Makah指出的那样，你打开了很多文件，这很慢 . 要解决此问题，请更改循环的顺序（请参阅下面的代码） . 这将从407,003文件打开切换到367.沿着相同的行，让我们创建一次FileSystemObject，而不是每个文件打开一次 .

此外，VBA在从/向Excel读取/写入数据时出乎意料地缓慢 . 我们可以通过使用类似的代码将largw数据块一次性加载到VBA中来处理这个问题

dim data as Variant
data = Range("A1:Z16000").value

然后将它写回一个像大块的Excel中

Range("A1:Z16000").value = data

我还在代码中添加了动态检查数据维度的代码 . 我们假设数据在单元格 A2 中开始，如果 A3 为空，我们使用单个单元格 A2 . 否则，我们使用 .End(xlDown) 向下移动到 A 列中第一个空单元格的正上方 . 这相当于按 ctrl+shift+down .

注意：以下代码尚未经过测试 . 此外，它需要为FileSystemObjects引用“Microsoft Scripting Runtime” .

Sub findStringMacro()
    Dim fn As String
    Dim lineString As String
    Dim fileName As String
    Dim searchTerm As String
    Dim i As Integer, j As Integer

    Dim FSO As Scripting.FileSystemObject
    Dim txtStr As Scripting.TextStream
    Dim file_rng As Range, file_cell As Range

    Dim output As Variant
    Dim output_index() As Integer

    Set FSO = New Scripting.FileSystemObject

    Set file_rng = Range("A2")
    If IsEmpty(file_rng) Then Exit Sub
    If Not IsEmpty(file_rng.Offset(1, 0)) Then
        Set file_rng = Range(file_rng, file_rng.End(xlDown))
    End If

    If IsEmpty(Range("C2")) Then Exit Sub
    If IsEmpty(Range("C3")) Then
        output = Range("C2")
    Else
        output = Range(Range("C2"), Range("C2").End(xlDown))
    End If

    ReDim Preserve output(1 To UBound(output, 1), 1 To file_rng.Rows.Count + 1)
    ReDim output_index(1 To UBound(output, 1))
    For i = 1 To UBound(output, 1)
        output_index(i) = 2
    Next i

    For Each file_cell In file_rng
        fn = file_cell.Value    'Range("A" & j)
        fileName = file_cell.Offset(0, 1).Value 'Range("B" & j)
        Set txtStr = FSO.OpenTextFile(fn)
        Do While Not txtStr.AtEndOfStream
            lineString = txtStr.ReadLine
            For i = 1 To UBound(output, 1)
                searchTerm = output(i, 1)   'Range("C" & i)
                If InStr(1, lineString, searchTerm, vbTextCompare) Then
                    If output(i, output_index(i)) <> fileName Then
                        output_index(i) = output_index(i) + 1
                        output(i, output_index(i)) = fileName
                    End If
                End If
            Next i
        Loop
        txtStr.Close
    Next file_cell

    Range("C2").Resize(UBound(output, 1), UBound(output, 2)).Value = output

    Set txtStr = Nothing
    Set FSO = Nothing
    Set file_cell = Nothing
    Set file_rng = Nothing
End Sub

回复于 2024-04-28T08:23:02+08:00

改进/优化Excel宏以在文本报告的文件夹中搜索文本短语

1 回答

相关问题