返回列表 上一主題 發帖

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

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
1# 跳轉到 »
發表於 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

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 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

        靜思自在 : 真正的愛心，是照顧好自己的這顆心。
返回列表 上一主題