如何將文件中的特定文本導入到excel中？

Question

我通過@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中。認爲這是因爲文本文檔中的每一行都有一個單元格 - 即使沒有寫入任何內容。

Answer 1

這裏被填充在每個文件中的Excel工作表一行，解決方案開始在第2行。您應該手動填寫職稱即第一行如下：

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：」行，則會將工作表中的相應單元格留空，而不是將「答13：「在那裏，導致轉變。

即使這些行的順序會改變，並且「From：」會出現在「Date：」之後，但這不會對輸出產生負面影響。 「From」值始終會進入第一列，第二列中的「Date」值等。

另外，如果您的文件包含許多其他格式不同的行，則它們都將被忽略。

Answer 2

更換「你當的」身體與以下行

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