Board logo

標題: 如何匯入多個清單編號的文字檔 [打印本頁]
作者: luke    時間: 2012-4-20 22:23     標題: 如何匯入多個清單編號的文字檔

各位大大

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

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

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

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

煩請先進 大大指導

[attach]10550[/attach]
作者: Hsieh    時間: 2012-4-21 00:15

回復 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
複製代碼
作者: luke    時間: 2012-4-21 11:50

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

     煩請先進 大大指導
作者: Hsieh    時間: 2012-4-21 13:10

回復 3# luke

fs = Replace(ThisWorkbook.FullName, ".xls", ".csv")
這句就是取得文字檔的完整檔名，只要改成所要匯入的檔名即可
整個程式適用所有循序檔案，只要分欄的規則一樣應該都可行
所以不須轉成CSV檔案，直接開啟txt檔案即可，也不會透過讀取內容到工作表，是直接依照你的txt內容處理
作者: luke    時間: 2012-4-21 19:09

回復 4# Hsieh


    謝謝H大

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

      煩請先進 大大指導
      [attach]10567[/attach]
作者: Hsieh    時間: 2012-4-21 19:46

回復 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執行再重新執行程式即可
[attach]10568[/attach]



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