今日要談的，是資料匯入後逐行尋找關鍵字的作法，以下有兩個寫好的子程式先為各位介紹：

Public Function SelectFile(strPath As String, strFileType As String) As String
'選擇檔案，完成後會帶出包含目錄的完整路徑字串到SelectFile字串變數中
'變數說明:
'strPath 開啟路徑
'strFileType 檔案類型

Dim a As Object
Set a = CreateObject("MSComDlg.CommonDialog")
'使用MSComDlg.CommonDialog子集來開啟檔案選擇框
'執行異常或沒有.ocx檔，請到下面網站瀏覽：
'http://windowsxp.mvps.org/comdlg32.htm

'若路徑最後沒有斜線「\」則補上斜線
If Right(strPath, 1) = "\" Then
    a.Filename = strPath & strFileType
Else
    a.Filename = strPath & "\" & strFileType
End If

'開啟視窗
a.ShowOpen

'檢查是否有選擇檔案，若最後字串與檔案類型字串(strFileType)相同
'則塞入空白，有選擇，則輸出完整路徑
If Right(a.Filename, Len(strFileType)) = strFileType Then
    SelectFile = ""
Else
    SelectFile = a.Filename
End If

End Function






Function PutRowData(strData As String, strSheets As String, strCol As String)
'塞資料到指定欄位，並放到該欄的最後空白列
'資料串由Tab字元自動切開，放置不同欄的資料到不同欄位裡
'
'strData 資料串
'strSheets 指定工作表
'strCol 指定欄位（英文字）

    Dim objDes As Object
    Set objDes = Sheets(strSheets)
    iNewRow = objDes.Range(strCol & "65535").End(xlUp).Row + 1
    
    tmp = Split(strData, vbTab)
    
    For i = 0 To UBound(tmp)
        objDes.Range(strCol & iNewRow).Offset(0, i) = tmp(i)
    Next

End Function

這兩個子程式，SelectFile是用來選擇檔案的，可以帶出該檔案的完整路徑。PutRowData則是將一串多欄字串資料，在依照TAB字元切開，然後塞到不同欄位裡，並且判斷空白列位置。

接下來，我們來看看主程式：

Public Function ReadATextFileToEOF(strKeyWord As String, Optional strPath As String, Optional strFileType As String = "*.*")
'讓user選擇純文字檔，打開檔案後，逐行搜尋，找到關鍵字，就把資料放到現在的工作表內
'變數說明
'strKeyWord 關鍵字
'strPath 預設開啟路徑
'strFileType 檔案類型 *.txt 或其他
'

Dim intFile As Integer
Dim strFile As String
Dim strIn As String
Dim bnFound As Boolean

booFound = False
strOut = vbNullString
intFile = FreeFile()


strFile = SelectFile(strPath, strFileType)

If Len(strFile) = 0 Then Exit Function

'使用Open方式開啟純文字檔(不支援UTF8)
Open strFile For Input As #intFile
i = 0
Do While Not EOF(intFile)
    Line Input #intFile, strIn '依照「行」來讀取資料
    i = i + 1
    j = InStr(strIn, strKeyWord) '使用InStr字串搜尋，有找到關鍵字，就帶入到工作表中
    If j > 0 Then
        Call PutRowData("關鍵字「" & strKeyWord & "」在第 " & i & "行，第 " & j & "字元。" & vbTab & strIn, ActiveSheet.Name, "A")
        bnFound = True
    End If
Loop

Close #intFile

If bnFound = False Then
    MsgBox "找不到關鍵字！"
End If
End Function

該程式用來讀取純文字檔，並且逐行搜尋，找到關鍵字後，把關鍵字放到現在的工作表中存放。

比如我們有個文字檔，內容如Day2裡的文字相同，這是由Day2的工作表複製到純文字檔後存檔起來的，欄位間為Tab字元。存放在我的文件 (MyDocuments)中。

然後，我們用以下指令來搜尋關鍵字：

Sub Day17()
    Call ReadATextFileToEOF("陳", SpecialFolders("MyDocuments"), "*.txt")
End Sub

透過昨日建立的SpecialFolders子程式來帶出我的文件所在位置，搜尋關鍵字為「陳」的列，並將資料放置在現在的工作表中。

執行前工作表

開啟後的選擇視窗

執行後結果如下：

這樣的程式架構不知道各位看的有懂還是沒懂呢？裡面可以針對自己需求去調整，相信可以玩出非常多的花樣！