Board logo

標題: [發問] 想請教如何從一個txt檔轉出成很多個excel檔 [打印本頁]
作者: flowrew    時間: 2015-2-25 13:58     標題: 想請教如何從一個txt檔轉出成很多個excel檔

本帖最後由 GBKEE 於 2015-2-25 15:05 編輯

各位親愛的大大午安
    有個小問題想要跟各位請益，
    要如何將一個有好幾行資料的txt檔，匯出成每一行一個excel檔
    小弟目前的txt檔格式如下
    [attach]20290[/attach]
    如圖所示有三行資料
    上面SN及Model是要輸出的每個execl都要代入的
    然後三行資料各自匯到各excel
    [attach]20291[/attach]
   其中C欄的資料內有兩部分，第一部分跟第二部分中間有個空格，各自要拉到不同的excel欄位

   目前小弟只會做選檔案按鍵跟排到excel，苦手，請各位的幫忙，萬分感謝
作者: luhpro    時間: 2015-2-25 22:21

本帖最後由 luhpro 於 2015-2-25 22:24 編輯
各位親愛的大大午安
    有個小問題想要跟各位請益，
    要如何將一個有好幾行資料的txt檔，匯出成每一行 ...
flowrew 發表於 2015-2-25 13:58

僅就你提供的圖檔猜測文字檔的內容,試試看...
  1. Sub nn()
  2.   Dim iMode%, iBgn%, iCol%
  3.   Dim lRow&
  4.   Dim sStr$, sTemp$
  5.   Dim vD
  6.   Dim vFs, vF
  7.   
  8.   Cells.Clear
  9.   
  10.   Set vD = CreateObject("Scripting.Dictionary")
  11.   lRow = 3
  12.   iCol = 3
  13.   iMode = 0
  14.   Set vFs = CreateObject("Scripting.FileSystemObject")
  15.   Set vF = vFs.OpenTextFile(ThisWorkbook.Path & "\123.txt", 1, -2)
  16.     Do While Not vF.AtEndOfStream
  17.       sStr = Trim(vF.ReadLine)
  18.       If sStr <> "" Then
  19.       
  20.         Select Case iMode
  21.           Case Is > 2 ' 資料區
  22.             iBgn = InStr(1, sStr, " ")
  23.             Cells(vD("1"), iCol) = Left(sStr, iBgn - 1)
  24.             
  25.             iBgn = InStr(iBgn, sStr, " ")
  26.             GoSub SkipSpace
  27.             Cells(vD("2"), iCol) = sTemp
  28.             
  29.             iBgn = InStr(iBgn, sStr, " ")
  30.             GoSub SkipSpace
  31.             Cells(vD("3"), iCol) = sTemp
  32.             
  33.             iBgn = InStr(iBgn, sStr, " ")
  34.             GoSub SkipSpace
  35.             Cells(vD("3") + 1, iCol) = sTemp
  36.             
  37.             iBgn = InStr(iBgn, sStr, " ")
  38.             GoSub SkipSpace
  39.             Cells(vD("4"), iCol) = sTemp
  40.             iCol = iCol + 1
  41.                            
  42.           Case 0 ' SN
  43.             If InStr(1, sStr, "SN") > 0 Then
  44.               Cells(lRow, 2) = "SN"
  45.               Cells(lRow, 3) = Trim(Mid(sStr, InStr(1, sStr, ":") + 1, 10))
  46.               iMode = iMode + 1
  47.               lRow = lRow + 1
  48.             End If
  49.         
  50.           Case 1 ' Model
  51.             If InStr(1, sStr, "Model") > 0 Then
  52.               Cells(lRow, 2) = "Model"
  53.               Cells(lRow, 3) = Trim(Mid(sStr, InStr(1, sStr, ":") + 1, 10))
  54.               iMode = iMode + 1
  55.               lRow = lRow + 2
  56.             End If

  58.           Case 2 ' A B C D
  59.             iBgn = InStr(1, sStr, " ")
  60.             Cells(lRow, 2) = Left(sStr, iBgn - 1)
  61.             vD("1") = lRow
  62.             
  63.             GoSub SkipSpace
  64.             lRow = lRow + 1
  65.             Cells(lRow, 2) = sTemp
  66.             vD("2") = lRow
  67.             iBgn = InStr(iBgn, sStr, " ")
  68.             
  69.             GoSub SkipSpace
  70.             lRow = lRow + 2
  71.             Cells(lRow, 2) = sTemp
  72.             vD("3") = lRow
  73.             iBgn = InStr(iBgn, sStr, " ")
  74.             
  75.             GoSub SkipSpace
  76.             lRow = lRow + 2
  77.             Cells(lRow, 2) = sTemp
  78.             vD("4") = lRow
  79.             iMode = iMode + 1
  80.         End Select
  81.       End If
  82.     Loop
  83.   vF.Close
  84.   
  85. Exit Sub

  87. SkipSpace:
  88.     Do While Mid(sStr, iBgn, 1) = " "
  89.       iBgn = iBgn + 1
  90.     Loop
  91.     sTemp = Trim(Mid(sStr, iBgn, IIf(InStr(iBgn, sStr, " ") = 0, _
  92.                            Len(sStr) + 1, InStr(iBgn, sStr, " ")) - iBgn))
  93.   Return
  94. End Sub
複製代碼
[attach]20294[/attach]
[attach]20295[/attach]
作者: flowrew    時間: 2015-2-26 10:37

回復 2# luhpro

謝謝luhpro大的回答，解了不少疑惑，非常感謝。<(_ _)>

luhpro大的方式是把他們合成一個excel
我的目的是希望能夠從這個有三行資料的txt檔匯成3個excel
每1個excel裡面就只有一行資料
我卡在這邊動不了。
作者: bobomi    時間: 2015-2-26 11:43

橫的叫列, 不叫行
作者: stillfish00    時間: 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
複製代碼
作者: flowrew    時間: 2015-2-26 14:49

橫的叫列, 不叫行
bobomi 發表於 2015-2-26 11:43


阿    對不起    小弟搞不清楚   感謝大大指教
作者: flowrew    時間: 2015-2-26 14:51

回復  flowrew
stillfish00 發表於 2015-2-26 14:08


多謝大大，真的分成三份了，太強了，感謝您的指導
作者: flowrew    時間: 2015-2-26 18:19

Dear  stillfish00大大

想請教一下，我用巨集錄了個form，只是簡單的上色及加上標語，拉格子大小等
希望能夠當excel每一個值帶入後(就是您寫的程式的第56列後面)加上這個巨集把excel畫面整理。
但是測試都出現1004。我沒有宣告任何東西，只是把那個巨集加上去。
後來再逐行除錯的時候，一到我加的第一行就卡住了。
再煩請您幫幫忙，感恩~
大概如下面這樣
  1.   sName = Left(vFile, Len(vFile) - 4)
  2.     For i = 0 To oMatch.Count - 1
  3.         With Workbooks.Add
  4.             With .Sheets(1)
  5.                 .[B3].Value = "SN"
  6.                 .[C3].Value = sSN
  7.                 .[B4].Value = "Model"
  8.                 .[C4].Value = sModel
  9.                
  10.                 .[B6].Value = arHeader(0)
  11.                 .[C6].Value = oMatch(i).submatches(0)
  12.                 .[B7].Value = arHeader(1)
  13.                 .[C7].Value = oMatch(i).submatches(1)
  14.                
  15.                 .[B9].Value = arHeader(2)
  16.                 .[C9].Value = oMatch(i).submatches(2)
  17.                 .[C10].Value = oMatch(i).submatches(3)

  19.                 .[B11].Value = arHeader(3)
  20.                 .[C11].Value = oMatch(i).submatches(4)
  21.             End With
  22.         
  23.                     Range("B2").Select
  24.                     ActiveCell.FormulaR1C1 = "甲"
  25.                     Range("B3").Select
  26.                     ActiveCell.FormulaR1C1 = _
  27.                         "乙" & Chr(10) & "丙"
  28.                     Range("B2:H2").Select
  29.                     With Selection
  30.                         .HorizontalAlignment = xlCenter
  31.                         .VerticalAlignment = xlBottom
  32.                         .WrapText = False
  33.                         .Orientation = 0
  34.                         .AddIndent = False
  35.                         .IndentLevel = 0
  36.                         .ShrinkToFit = False
  37.                         .ReadingOrder = xlContext
  38.                         .MergeCells = False
  39.                     End With
複製代碼
作者: stillfish00    時間: 2015-2-26 18:37

回復 8# flowrew
附檔吧，你是說有使用UserForm?  應該是要改成沒Select的寫法吧
作者: flowrew    時間: 2015-3-3 09:19

回復 9# stillfish00

Dear stillfish00大
我把東西放在附件裡,FYI
另外為何不能使用select，再請您指導，感恩



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)