返回列表 上一主題 發帖

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

本帖最後由 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

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

  85. SkipSpace:
  86.     Do While Mid(sStr, iBgn, 1) = " "
  87.       iBgn = iBgn + 1
  88.     Loop
  89.     sTemp = Trim(Mid(sStr, iBgn, IIf(InStr(iBgn, sStr, " ") = 0, _
  90.                            Len(sStr) + 1, InStr(iBgn, sStr, " ")) - iBgn))
  91.   Return
  92. End Sub
複製代碼
test.zip (10.16 KB)

TOP

        靜思自在 : 做好事不能少我一人,做壞事不能多我一人。
返回列表 上一主題