Question

尝试从文本文件中提取文本行到excel，但前提是文本行中包含特定名称。忽略其余的行。

我目前正在处理大量文本文件，其中包含某些产品的标准化信息。每个文件具有相同的产品列表，但信息来自不同的日期。我整理了一些代码，从目录中包含的文本文件的每一行中提取代码，并将它们一起包含在单个excel电子表格中。

我要更改的是代码仅复制文本行中包含“ Large Cap Index”的特定名称。其余数据可以忽略。这是在尝试减少提取数据所花费的时间，因为每个文本文件中只需要大约5％的行。

Sub ReadFilesIntoActiveSheet()
    Dim fso As FileSystemObject
    Dim folder As folder
    Dim file As file
    Dim FileText As TextStream
    Dim TextLine As String
    Dim Items() As String
    Dim i As Long
    Dim cl As Range
    ' Get a FileSystem object
    Set fso = New FileSystemObject
    ' get the directory you want
    Set folder = fso.GetFolder("C:\Users\crowe12\Desktop\Projects\CRSP\Test")
    Set cl = ActiveSheet.Cells(1, 1)
    For Each file In folder.Files
        Set FileText = file.OpenAsTextStream(ForReading)
        Do While Not FileText.AtEndOfStream
            TextLine = FileText.ReadLine
            Items = Split(TextLine, "|")
            cl.Value = folder & "\" & file.Name
            For i = 0 To UBound(Items)
                cl.Offset(0, i + 1).Value = Items(i)
            Next
            Set cl = cl.Offset(1, 0)
        Loop
        FileText.Close
    Next file
    Set FileText = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing
End Sub

Answer 1

您可以使用以下方法测试每一行：

Dim x As Long
x = 1
For i = 0 To UBound(Items)
    If Items(i) Like "*your value here*" Then
        cl.Offset(0, x).Value = Items(i) '<< this offsets to the right: 
                                         '   did you mean to offset down?
        x = x + 1
    End If

Next

Answer 2

阅读该行时，为什么不检查所需文本是否存在，然后根据检查结果跳过该文本

Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
Dim textToSkip as String: textToSkip="Large Cap Index"
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder = fso.GetFolder("C:\Users\crowe12\Desktop\Projects\CRSP\Test")
Set cl = ActiveSheet.Cells(1, 1)
For Each file In folder.Files
    Set FileText = file.OpenAsTextStream(ForReading)
    Do While Not FileText.AtEndOfStream
        TextLine = FileText.ReadLine
        'You can covert this to lowercase before hand to match ignoring case
        If Instr(1,TextLine,textToSkip) > 1 Then
         Items = Split(TextLine, "|")
         cl.Value = folder & "\" & file.Name
         For i = 0 To UBound(Items)
          cl.Offset(0, i + 1).Value = Items(i)
         Next
         Set cl = cl.Offset(1, 0)
        End If
    Loop
    FileText.Close
Next file
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub

除了条件外，我在您的代码中没有做太多更改

Excel VBA-从多个文本文件中提取包含特定名称的行

2 个答案: