如何将文件中的特定文本导入到excel中？ [英] How to import specific text from files in to excel?

问题描述

我发现这个代码由@Scott Holtzman，我需要调整一点，以满足我的需要。该代码将文本文件中的每一行都放在Excel文档中，并将其放在excel表格（A1，B1，C1等）中的单独列中，每个文本文件都存储在一个单独的行（1,2,3等）中。首先，我希望它只将文本放入excel表格中，如果行以特定的文本开头，则第二个我希望它将每行中的一些文本复制到Excel表中。

I found this code by @Scott Holtzman and I need to tweek it a bit to match my needs. This code takes each line in a text file and puts it into seperate columns in an excel sheet(A1, B1, C1 and so on), each text file is stored in a seperate row(1,2,3 and so on). First i want it to only put text into the excel sheet if the line starts with a specific text, second i want it to only copy some of the text from each line into the excel sheet.

Sub ReadFilesIntoActiveSheet()

Dim fso As FileSystemObject
Dim folder As folder, file As file, FileText As TextStream
Dim TextLine As String, Items() As String
Dim i As Long, cl As Range

' Get a FileSystem object
Set fso = New FileSystemObject

' get the directory you want
Set folder = fso.GetFolder("D:\YourDirectory\")

Dim x As Long
x = 1 'to offset rows for each file

' Loop thru all files in the folder
For Each file In folder.Files

' set the starting point to write the data to
Set cl = ActiveSheet.Cells(x, 1)

' Open the file
Set FileText = file.OpenAsTextStream(ForReading)

Dim j As Long
j = 0 'to offset columsn for each line
' Read the file one line at a time
Do While Not FileText.AtEndOfStream

    TextLine = FileText.ReadLine 'read line

    cl.Offset(, j).Value = TextLine 'fill cell

    j = j + 1
Loop

' Clean up
FileText.Close

x = x + 1

Next file

Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing

End Sub

这是我的文本文件的样子：

Here is what my text files look like:

From:NameName           'want all text except the "FROM:"
Date:yyyy.mm.dd         'want all text except the "Date:"
Type: XXXXXXXXX         ' I don't want this line into excel
To: namename            ' I don't want this line into excel

----------------------------- xxxxxxx ---------------------
A1: Tnr xxxxxxxxxxxxx   'want all text except the "A1: Tnr" only next 13char
A2: texttext            'want all text except the "A2:"
An:                     'A1 and up to A14
A14: texttext           'want all text except the "A14:"  

------------------------------ xxxxxx ----------------------

所以在文本文件中总共有22行。

So in total there is 22 lines in the text file.

如果可以使用FROM :, DATE :, A1：到A14：作为第一行中的标题，将是史诗般的。

And if it is possible to use the FROM:, DATE:, A1: to A14: as headers in the first row that would be epic.

已尝试google我的方式，并尝试一下：

have tried to google my way to it, and tried a bit with this:

TextLine =    FileText.ReadLine 'read line
If InStr(TextLine, "A1:") 

，但这只适用于一行，我似乎无法让它与几行一起工作。此外，它将输出放在单元格F1中，而不是A1。认为这是因为文本文档中的每一行都会获取一个单元格，即使没有写入任何内容。

but that works only for one line and i cant seem to get it to work with several lines. In addition it puts the output in cell F1, instead of A1. think this is since each line in text document gets one cell - even if nothing is written to it.

推荐答案

它将从第2行开始在每个文件的Excel工作表中填写一行。您应该按照以下方式手动填写第一行中的标题：

Here is a solution that fills one row in the Excel sheet per file, starting at row 2. You should manually fill in the titles in that first row as follows:

From | Date | A1 | A2 | ... | A14

您不感兴趣的行将被跳过，并将值放在正确的列中：

The lines that you are not interested in are skipped, and the values are put in the correct columns:

Sub ReadFilesIntoActiveSheet()
    Dim fso As FileSystemObject
    Dim folder As folder, file As file, FileText As TextStream
    Dim TextLine As String
    Dim cl As Range

    Dim num As Long ' numerical part of key, as in "Ann:"
    Dim col As Long ' target column in Excel sheet
    Dim key As String ' Part before ":"
    Dim value As String ' Part after ":"

    ' Get a FileSystem object
    Set fso = New FileSystemObject

    ' Get the directory you want
    Set folder = fso.GetFolder("D:\YourDirectory\")

    ' Set the starting point to write the data to
    ' Don't write in first row where titles are
    Set cl = ActiveSheet.Cells(2, 1)

    ' Loop thru all files in the folder
    For Each file In folder.Files
        ' Open the file
        Set FileText = file.OpenAsTextStream(ForReading)

        ' Read the file one line at a time
        Do While Not FileText.AtEndOfStream

            TextLine = FileText.ReadLine 'read line

            key = Split(TextLine & ":", ":")(0)
            value = Trim(Mid(TextLine, Len(key)+2))
            num = Val(Mid(key,2))
            If num Then key = Replace(key, num, "") ' Remove number from key
            col = 0
            If key = "From" Then col = 1
            If key = "Date" Then col = 2
            If key = "A"    Then col = 2 + num
            If col Then
                cl.Offset(, col-1).Value = value ' Fill cell
            End If
        Loop

        ' Clean up
        FileText.Close
        ' Next row
        Set cl = cl.Offset(1) 
    Next file
End Sub

上述代码即使在您的文件，就像A12：行不存在一样，这将使表格中的相应单元格空白，而不是将A13：的值放在那里，导致转移。

The above code will work well even if items are missing in your file, like if the line with "A12:" would not be present, this will leave the corresponding cell in the sheet empty, instead of putting the value of "A13:" there, causing a shift.

即使行的顺序会改变，而来自：将出现在日期：之后，这不会对输出产生负面影响。 From值将始终进入第一列，第二列中的Date值等。

Even if the order of the lines would change, and "From:" would appear after "Date:", this will not have a negative effect in the output. "From" values will always get into the first column, "Date" values in the second, etc.

此外，如果您的文件将包含许多其他不同格式的行，他们都会被忽视。

Also, if your file would contain many other lines with differing formats, they will all be ignored.

这篇关于如何将文件中的特定文本导入到excel中？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！