iT邦幫忙

DAY 17
3

Excel VBA 的眉眉角角系列 第 17

Excel VBA 的眉眉角角Day17: 匯入文字檔後逐行檢查

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

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子程式來帶出我的文件所在位置,搜尋關鍵字為「陳」的列,並將資料放置在現在的工作表中。

執行前工作表

開啟後的選擇視窗

執行後結果如下:

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


上一篇
Excel VBA 的眉眉角角Day16: 取得特殊路徑與UTF8檔案名稱寫入問題
下一篇
Excel VBA 的眉眉角角Day18: 讀取UTF8檔案後,利用Split功能切割以及Resize與Application.Transpose的介紹
系列文
Excel VBA 的眉眉角角30

尚未有邦友留言

立即登入留言