返回列表 上一主題 發帖

[發問] 如何以Excel VBA多重匯入文字檔並指定文字為儲存格？

hellrack

帖子
4 
主題
1 
精華
0 
積分
5 
點名
0  
作業系統
win7 
軟體版本
7 
閱讀權限
10 
註冊時間
2014-11-12 
最後登錄
2014-11-13 
1# 跳轉到 » 正序看帖
打印
tT
發表於 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>>"

粗體字為需要抓取的字串

輸入結果希望如圖所示


附件為資料原始檔與程式碼
rowdata.zip (21.72 KB)

還請各位前輩指導與解惑
收藏 分享

hellrack

帖子
4 
主題
1 
精華
0 
積分
5 
點名
0  
作業系統
win7 
軟體版本
7 
閱讀權限
10 
註冊時間
2014-11-12 
最後登錄
2014-11-13 
7#
發表於 2014-11-13 22:48 | 只看該作者
回復 6# stillfish00

it's works
再次感謝大大的幫忙！

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
6#
發表於 2014-11-13 21:13 | 只看該作者
回復 5# hellrack
  1. Sub Test()
  2.   Dim vFiles, sFile
  3.   Dim oFSO As Object, sText As String
  4.   Dim oRegex As Object, oMatch As Object, ar, i, j
  5.   
  6.   vFiles = Application.GetOpenFilename(Filefilter:="文字檔 (*.log),*.log", Title:="選擇檔案(可多選)", MultiSelect:=True)
  7.   If Not IsArray(vFiles) Then Exit Sub
  8.   
  9.   Set oFSO = CreateObject("Scripting.FileSystemObject")
  10.   Set oRegex = CreateObject("Vbscript.Regexp")
  11.   oRegex.Pattern = "DIEID:[\S\s]*?([0-9a-f]{8}\s+[0-9a-f]{8}\s+[0-9a-f]{8})[\S\s]+?" & _
  12.                     "Test info, tempature : ([\d]+)[\S\s]+?" & _
  13.                     "phybist test finish result :.*?\[(\d+)\][\S\s]+?" & _
  14.                     "Tester send msg:\s*""<<(.+)>>"""
  15.   oRegex.Global = True
  16.   
  17.   With Sheets(1)
  18.     .UsedRange.ClearContents
  19.     .[A1].Resize(1, 4) = Array("名稱1", "名稱2", "名稱3", "名稱4")
  20.    
  21.     For Each sFile In vFiles
  22.       sText = oFSO.OpenTextFile(sFile, 1).ReadAll
  23.       If Not oRegex.Test(sText) Then MsgBox "Format is not match:" & vbCr & sFile: Exit Sub
  24.       Set oMatch = oRegex.Execute(sText)
  25.       ReDim ar(0 To oMatch.Count - 1, 0 To 3)
  26.       For i = 0 To oMatch.Count - 1
  27.         With oMatch.Item(i)
  28.           For j = 0 To .submatches.Count - 1
  29.             ar(i, j) = .submatches(j)
  30.           Next
  31.         End With
  32.       Next
  33.       .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(ar) + 1, UBound(ar, 2) + 1) = ar
  34.     Next
  35.     .UsedRange.EntireColumn.AutoFit
  36.   End With
  37. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

hellrack

帖子
4 
主題
1 
精華
0 
積分
5 
點名
0  
作業系統
win7 
軟體版本
7 
閱讀權限
10 
註冊時間
2014-11-12 
最後登錄
2014-11-13 
5#
發表於 2014-11-13 20:53 | 只看該作者
回復 2# stillfish00


另問stillfish00前輩
先前提供的附件為一顆的資料，若像此版更新附件中包含多顆的資料，我該怎麼修改呢？

有勞前輩指點了
updateattch.rar (3.21 KB)

TOP

hellrack

帖子
4 
主題
1 
精華
0 
積分
5 
點名
0  
作業系統
win7 
軟體版本
7 
閱讀權限
10 
註冊時間
2014-11-12 
最後登錄
2014-11-13 
4#
發表於 2014-11-13 20:30 | 只看該作者
回復 2# stillfish00


    感謝stillfish00大大，大幅減少小弟的工作量！再次萬分感謝！

TOP

mmxxxx

帖子
61 
主題
7 
精華
0 
積分
72 
點名
0  
作業系統
win 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
註冊時間
2014-11-4 
最後登錄
2015-9-16 
3#
發表於 2014-11-13 16:19 | 只看該作者
回復 2# stillfish00

Stillfish00大大, 今天真是學到了,
不知文字檔也可如此讀取, 並利用Regular Expression language 讀取.
太利害了.
感謝.

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2014-11-13 14:22 | 只看該作者
本帖最後由 stillfish00 於 2014-11-13 14:26 編輯

回復 1# hellrack
  1. Sub Test()
  2.   Dim vFiles, sFile
  3.   Dim oFSO As Object, sText As String
  4.   Dim oRegex As Object, oMatch As Object, ar
  5.   
  6.   vFiles = Application.GetOpenFilename(Filefilter:="文字檔 (*.log),*.log", Title:="選擇檔案(可多選)", MultiSelect:=True)
  7.   If Not IsArray(vFiles) Then Exit Sub
  8.   
  9.   Set oFSO = CreateObject("Scripting.FileSystemObject")
  10.   Set oRegex = CreateObject("Vbscript.Regexp")
  11.   oRegex.Pattern = "DIEID:[\S\s]*?([0-9a-f]{8}\s+[0-9a-f]{8}\s+[0-9a-f]{8})[\S\s]+?" & _
  12.                     "Test info, tempature : ([\d]+)[\S\s]+?" & _
  13.                     "phybist test finish result :.*?\[(\d+)\][\S\s]+?" & _
  14.                     "Tester send msg:\s*""<<(.+)>>"""
  15.    
  16.   With Sheets(1)
  17.     .UsedRange.ClearContents
  18.     .[A1].Resize(1, 4) = Array("名稱1", "名稱2", "名稱3", "名稱4")
  19.    
  20.     For Each sFile In vFiles
  21.       sText = oFSO.OpenTextFile(sFile, 1).ReadAll
  22.       If Not oRegex.Test(sText) Then MsgBox "Format is not match:" & vbCr & sFile : Exit Sub
  23.       Set oMatch = oRegex.Execute(sText)
  24.       ar = Array(oMatch.Item(0).submatches(0), oMatch.Item(0).submatches(1), oMatch.Item(0).submatches(2), oMatch.Item(0).submatches(3))
  25.       .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(1, UBound(ar) + 1) = ar
  26.     Next
  27.     .UsedRange.EntireColumn.AutoFit
  28.   End With
  29. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

        靜思自在 : 一個人的快樂．不是因為他擁有得多，而是因為他計較得少。
返回列表 上一主題