返回列表 上一主題 發帖

[發問] 想請教如何從一個txt檔轉出成很多個excel檔

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
1# 跳轉到 »
發表於 2015-2-26 14:08 | 顯示全部帖子
本帖最後由 stillfish00 於 2015-2-26 14:12 編輯

回復 1# flowrew
  1. Sub Test()
  2.     Dim vFile, oFs, oTs, sAll As String
  3.     Dim oRegexp, oMatch
  4.     Dim i As Long, sSN As String, sModel As String, arHeader() As String, sName As String
  5.    
  6.     vFile = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt", Title:="選擇檔案")
  7.     If StrComp(TypeName(vFile), "Boolean", vbTextCompare) = 0 Then Exit Sub
  8.    
  9.     Set oFs = CreateObject("Scripting.FileSystemObject")
  10.     Set oTs = oFs.openTextFile(vFile, 1)
  11.     sAll = oTs.ReadAll
  12.     sAll = Replace(sAll, vbCrLf, vbLf)
  13.    
  14.     Set oRegexp = CreateObject("vbscript.regexp")
  15.     With oRegexp
  16.         .Pattern = "SN\s*:\s*(\S*)"
  17.         Set oMatch = .Execute(sAll)
  18.         If oMatch.Count > 0 Then sSN = oMatch(0).submatches(0)
  19.         
  20.         .Pattern = "Model\s*:\s*(\S*)"
  21.         Set oMatch = .Execute(sAll)
  22.         If oMatch.Count > 0 Then sModel = oMatch(0).submatches(0)
  23.         
  24.         'Data Header
  25.         .MultiLine = True
  26.         .Pattern = "^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$"
  27.         Set oMatch = .Execute(sAll)
  28.         If oMatch.Count > 0 Then arHeader = Split(.Replace(oMatch(0), "$1,$2,$3,$4"), ",")
  29.         
  30.         'Data Value
  31.         .Global = True
  32.         .Pattern = "^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$"
  33.         Set oMatch = .Execute(sAll)
  34.     End With
  35.    
  36.     sName = Left(vFile, Len(vFile) - 4)
  37.     For i = 0 To oMatch.Count - 1
  38.         With Workbooks.Add
  39.             With .Sheets(1)
  40.                 .[B3].value = "SN"
  41.                 .[C3].value = sSN
  42.                 .[B4].value = "Model"
  43.                 .[C4].value = sModel
  44.                
  45.                 .[B6].value = arHeader(0)
  46.                 .[C6].value = oMatch(i).submatches(0)
  47.                 .[B7].value = arHeader(1)
  48.                 .[C7].value = oMatch(i).submatches(1)
  49.                
  50.                 .[B9].value = arHeader(2)
  51.                 .[C9].value = oMatch(i).submatches(2)
  52.                 .[C10].value = oMatch(i).submatches(3)

  54.                 .[B11].value = arHeader(3)
  55.                 .[C11].value = oMatch(i).submatches(4)
  56.             End With
  57.             .SaveAs sName & "_" & i + 1 & ".xlsx"
  58.             .Close
  59.         End With
  60.     Next
  61.     MsgBox "完成"
  62. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2015-2-26 18:37 | 顯示全部帖子
回復 8# flowrew
附檔吧，你是說有使用UserForm?  應該是要改成沒Select的寫法吧
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

        靜思自在 : 人事的艱難與琢磨，就是一種考驗。
返回列表 上一主題