我在@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。 认为这是因为文本文档中的每一行都有一个单元格 - 即使没有写入任何内容。
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 SubHere 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 ----------------------So in total there is 22 lines in the text file.
And if it is possible to use the FROM:, DATE:, A1: to A14: as headers in the first row that would be epic.
have tried to google my way to it, and tried a bit with this:
TextLine = FileText.ReadLine 'read line If InStr(TextLine, "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工作表中填充一行。您应该手动填写第一行中的标题，如下所示：
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：”之后，这也不会对输出产生负面影响。 “From”值将始终进入第一列，“Date”值进入第二列，等等。
此外，如果您的文件包含许多具有不同格式的其他行，则它们都将被忽略。
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 | ... | A14The 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 SubThe 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.
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.
更多推荐
发布评论