標題:
[發問]
如何以Excel VBA多重匯入文字檔並指定文字為儲存格？
[打印本頁]
作者:
hellrack
時間:
2014-11-12 20:23
標題:
如何以Excel VBA多重匯入文字檔並指定文字為儲存格？
各位前輩
小弟由於工作上的需要，要匯入大量文字檔，並指定某些文字為儲存格的欄位。
因小弟不曾接觸vba，第一次整理資料時耗費不少時間，從網路上搜尋資料與自己摸索了多日。只得出半套成果（如附件）。
以下為文字檔格式
中略
2c23a040 c0004941 c5031a01
0029874c 00001ff8 51211000 20130830 a5a5a5a5
00000018 00000003 00000000 00000000 00000000 00000000 00000000 00000000
00000000 00000000 00000000 00000001 00000000 00000000 00000000 00000000
00000000 00000000 00000002 00000000 00000000 00000000 00000000
Test info, tempature :
32
中略
phybist test finish result : 0.................. at [
18765
]
中略
Tester send msg: "<<
ErrCode=00
>>"
粗體字為需要抓取的字串
輸入結果希望如圖所示
[attach]19535[/attach]
附件為資料原始檔與程式碼
[attach]19536[/attach]
還請各位前輩指導與解惑
作者:
stillfish00
時間:
2014-11-13 14:22
本帖最後由 stillfish00 於 2014-11-13 14:26 編輯
回復
1#
hellrack
Sub Test()
Dim vFiles, sFile
Dim oFSO As Object, sText As String
Dim oRegex As Object, oMatch As Object, ar
vFiles = Application.GetOpenFilename(Filefilter:="文字檔 (*.log),*.log", Title:="選擇檔案(可多選)", MultiSelect:=True)
If Not IsArray(vFiles) Then Exit Sub
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oRegex = CreateObject("Vbscript.Regexp")
oRegex.Pattern = "DIEID:[\S\s]*?([0-9a-f]{8}\s+[0-9a-f]{8}\s+[0-9a-f]{8})[\S\s]+?" & _
"Test info, tempature : ([\d]+)[\S\s]+?" & _
"phybist test finish result :.*?\[(\d+)\][\S\s]+?" & _
"Tester send msg:\s*""<<(.+)>>"""
With Sheets(1)
.UsedRange.ClearContents
.[A1].Resize(1, 4) = Array("名稱1", "名稱2", "名稱3", "名稱4")
For Each sFile In vFiles
sText = oFSO.OpenTextFile(sFile, 1).ReadAll
If Not oRegex.Test(sText) Then MsgBox "Format is not match:" & vbCr & sFile : Exit Sub
Set oMatch = oRegex.Execute(sText)
ar = Array(oMatch.Item(0).submatches(0), oMatch.Item(0).submatches(1), oMatch.Item(0).submatches(2), oMatch.Item(0).submatches(3))
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(1, UBound(ar) + 1) = ar
Next
.UsedRange.EntireColumn.AutoFit
End With
End Sub
複製代碼
作者:
mmxxxx
時間:
2014-11-13 16:19
回復
2#
stillfish00
Stillfish00大大, 今天真是學到了,
不知文字檔也可如此讀取, 並利用Regular Expression language 讀取.
太利害了.
感謝.
作者:
hellrack
時間:
2014-11-13 20:30
回復
2#
stillfish00
感謝stillfish00大大，大幅減少小弟的工作量！再次萬分感謝！
作者:
hellrack
時間:
2014-11-13 20:53
回復
2#
stillfish00
另問stillfish00前輩
先前提供的附件為一顆的資料，若像此版更新附件中包含多顆的資料，我該怎麼修改呢？
有勞前輩指點了
[attach]19544[/attach]
作者:
stillfish00
時間:
2014-11-13 21:13
回復
5#
hellrack
Sub Test()
Dim vFiles, sFile
Dim oFSO As Object, sText As String
Dim oRegex As Object, oMatch As Object, ar, i, j
vFiles = Application.GetOpenFilename(Filefilter:="文字檔 (*.log),*.log", Title:="選擇檔案(可多選)", MultiSelect:=True)
If Not IsArray(vFiles) Then Exit Sub
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oRegex = CreateObject("Vbscript.Regexp")
oRegex.Pattern = "DIEID:[\S\s]*?([0-9a-f]{8}\s+[0-9a-f]{8}\s+[0-9a-f]{8})[\S\s]+?" & _
"Test info, tempature : ([\d]+)[\S\s]+?" & _
"phybist test finish result :.*?\[(\d+)\][\S\s]+?" & _
"Tester send msg:\s*""<<(.+)>>"""
oRegex.Global = True
With Sheets(1)
.UsedRange.ClearContents
.[A1].Resize(1, 4) = Array("名稱1", "名稱2", "名稱3", "名稱4")
For Each sFile In vFiles
sText = oFSO.OpenTextFile(sFile, 1).ReadAll
If Not oRegex.Test(sText) Then MsgBox "Format is not match:" & vbCr & sFile: Exit Sub
Set oMatch = oRegex.Execute(sText)
ReDim ar(0 To oMatch.Count - 1, 0 To 3)
For i = 0 To oMatch.Count - 1
With oMatch.Item(i)
For j = 0 To .submatches.Count - 1
ar(i, j) = .submatches(j)
Next
End With
Next
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(ar) + 1, UBound(ar, 2) + 1) = ar
Next
.UsedRange.EntireColumn.AutoFit
End With
End Sub
複製代碼
作者:
hellrack
時間:
2014-11-13 22:48
回復
6#
stillfish00
it's works
再次感謝大大的幫忙！
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
