返回列表 上一主題 發帖

如何匯入多個清單編號的文字檔

如何匯入多個清單編號的文字檔

各位大大

小弟想將多個清單編號的該文字檔匯入sheet1表,

依照父項編號和父項名稱先作分類後,

然後按"項次","子項品號","品名","使用量","單位"和"備註",

分別取出內容和重新編號轉成欄位如sheet2表A:H欄所示

煩請先進 大大指導

TEST12.rar (28.04 KB)

回復 1# luke
  1. Sub Ex()
  2. Dim fs$, Mystr$, A(0 To 7), Ay()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. fs = Replace(ThisWorkbook.FullName, ".xls", ".csv")
  5. Open fs For Input As #1
  6. Do Until EOF(1)
  7. Line Input #1, Mystr
  8. If InStr(Mystr, "父項編號") > 0 Then
  9.    fa = Split(Mystr, ":")
  10.    f1 = Trim(Replace(fa(1), "父項名稱", "")): f2 = Trim(fa(2))
  11. End If
  12. Mystr = Trim(Mystr)
  13. If Val(Mystr) <> 0 Then
  14. m = Trim(Right(Mystr, 3)) '單位
  15. Mystr = Trim(Replace(Mystr, m, ""))
  16. k = Len(Mystr)
  17. Do Until Mid(Mystr, k, 1) = " "
  18. k = k - 1
  19. Loop
  20. n = Mid(Mystr, k) '數量
  21. Mystr = Trim(Left(Mystr, k))
  22. Mystr = Trim(Mid(Mystr, Len(Split(Mystr, " ")(0)) + 1))
  23. i = 1
  24. Do Until Mid(Mystr, i, 1) = " "
  25. i = i + 1
  26. Loop
  27. p = Trim(Left(Mystr, i)) '子項號
  28. w = Trim(Replace(Mystr, p, "")) '品名
  29. d(f2) = d(f2) + 1
  30.      ReDim Preserve Ay(x)
  31.      Ay(x) = Array(f1, f2, d(f2), p, w, n, m)
  32.      x = x + 1
  33. End If
  34. Loop
  35. Sheet3.[A7].Resize(x, 7).Value = Application.Transpose(Application.Transpose(Ay))
  36. Close #1
  37. End Sub
複製代碼
學海無涯_不恥下問

TOP

本帖最後由 luke 於 2012-4-21 15:25 編輯

回復 2# Hsieh


   謝謝H大

   第35列應為Sheet2.[A7]

   1.若文字檔得主檔名(TEST12.csv)與Excel檔(TEST12.xls)不同名稱時即文字檔得主檔名 為不同名稱, 應如何修改程式?

    2.若文字檔是 txt檔且排列格式內容不同是否能直接打開檔案
       再匯入不需經過sheet1表轉貼至sheet2表, 即直接開啟檔案整理後放入sheet1表
       (PS: 原始文字檔是txt檔, 利用開啟檔案再經過轉存成csv檔)

     煩請先進 大大指導

TOP

回復 3# luke

fs = Replace(ThisWorkbook.FullName, ".xls", ".csv")
這句就是取得文字檔的完整檔名,只要改成所要匯入的檔名即可
整個程式適用所有循序檔案,只要分欄的規則一樣應該都可行
所以不須轉成CSV檔案,直接開啟txt檔案即可,也不會透過讀取內容到工作表,是直接依照你的txt內容處理
學海無涯_不恥下問

TOP

回復 4# Hsieh


    謝謝H大

    原程式改成
     fs = Application.GetOpenFilename("Text Files (*.txt), *.txt")
     
     點選文字檔
     改選原TEST12.txt文字檔
     會出現"檔案已開啟"錯誤

      煩請先進 大大指導
       TEST12A.rar (23.91 KB)

TOP

回復 5# luke


沒有你說的問題,只是
sheet3.[A7].Resize(x, 7).Value = Application.Transpose(Application.Transpose(Ay))
要改成
sheet2.[A7].Resize(x, 7).Value = Application.Transpose(Application.Transpose(Ay))
會出現這種狀況,是因為你有執行過程式,但是沒有執行到
Close #1就結束程式
請以逐行(F8)執行,還未執行Open fs For Input As #1時
就跳到Close #1執行再重新執行程式即可
play.gif
2012-4-21 19:46
學海無涯_不恥下問

TOP

        靜思自在 : 君子立恆志,小人恆立志。
返回列表 上一主題