[英]How to import specific text from files in to excel?
我通过@Scott Holtzman找到了这段代码,我需要对其进行一些调整以满足我的需求。 此代码将文本文件中的每一行放入Excel工作表(A1,B1,C1等)的单独列中,每个文本文件存储在单独的行(1、2、3等)中。 首先,我希望它仅在行以特定文本开头的情况下才将文本放入excel工作表,其次我希望它仅将每行中的某些文本复制到excel工作表中。
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
我的文本文件如下所示:
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行。
并且如果可以使用FROM:,DATE:,A1:到A14:作为第一行的标题,那将是史诗般的。
尝试用谷歌搜索它,并尝试了一下:
TextLine = FileText.ReadLine 'read line
If InStr(TextLine, "A1:")
但这仅适用于一行,而我似乎无法使它适用于多行。 此外,它将输出放在单元格F1中,而不是A1中。 认为这是因为文本文档中的每一行都有一个单元格-即使没有写入任何内容。
用以下几行替换“ Do While's”主体
TextLine = FileText.ReadLine 'read line
If Not (Left(TextLine, 1) = "T" Or Left(TextLine, 1) = "-") Then
TextLine = Trim(Mid(TextLine, InStr(TextLine, ":") + 1))
If (TextLine <> "") Then
cl.Offset(, j).Value = TextLine 'fill cell
j = j + 1
End If
End If
这是一个解决方案,它从第2行开始在每个文件的Excel工作表中填充一行。您应该按如下方式手动填写第一行中的标题:
From | Date | A1 | A2 | ... | A14
将跳过您不感兴趣的行,并将值放在正确的列中:
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:”在那里,引起了转变。
即使行的顺序发生变化,并且“发件人:”将出现在“日期:”之后,这也不会对输出产生负面影响。 “ From”值将始终进入第一列,“ Date”值将进入第二列,依此类推。
同样,如果您的文件包含许多其他格式不同的行,则它们都将被忽略。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.