code vba Import text file to excel แล้วติดปัญหา

[benzdekhad]

ผมมีปัญหาการ import text file มาลง excel file โดยตัวอย่างที่ติดปัญหาคือ ข้อมูลจาก text file จะเป็น row เดียวกันเช่น
ข้อมูล "TCA1-046AS01 uptime is 1 year, 19 weeks, 1 day, 19 hours, 38 minutes"
แต่พอผม import ด้วย vba code ลง excel file ข้อมูลจะได้เป็น

TCA1-046AS01 uptime is 1 year
19 weeks
1 day
19 hours
38 minutes

ซึ่งเป็นข้อมูลที่มีหลายบรรทัดขึ้นมา ผมได้แนบ excel file และ text file ที่ผมใช้ เข้ามาโดยใน excel file column A จะเป็นผลลัพธ์ที่ได้จากการ import โดย vba code ส่วน column C คือผลลัพธ์ที่อยากให้ออกมาในรูปแบบนั้น รบกวนช่วยดู code vba ว่าผิดพลาดต้องส่วนใดด้วยครับ

...ขอบคุณครับ...

[snasui]

ลองตามนี้ครับ

ปรับ Code จาก

Code: Select all

Do While Not EOF(1)
      Input #1, FileText
      Rows(N).Columns(FirstEmpty) = FileText
      N = N + 1
Loop      '< Loop until end of file

เป็น

Code: Select all

Do While Not EOF(1)
      Line Input #1, FileText '<== Change this line
      Rows(N).Columns(FirstEmpty) = FileText
      N = N + 1
Loop      '< Loop until end of file

[benzdekhad]

เรียน อาจารย์ snasui

code ที่อาจารย์แก้ให้ นั้นผลลัพธ์การ import ข้อมูลมาได้ตามที่ต้องการเลยครับ แต่ทางผมติดอยู่คือ การ import ไฟล์ source 1 ในไฟล์แนบ ผมลอง import มาแล้วโปรแกรมค้างตลอดเลย แต่ ไฟล์ source 2 กลับ import ได้ปกติ ไม่ทราบว่า โค๊ด vba ที่ผมใช้ผิดพลาดต้องส่วนไหนเหรอครับ หรือว่าเป็นข้อจำกัดของโปรแกรม excel

[snasui]

ขอถามเพิ่มเติมว่าโปรแกรมฟ้องว่าอย่างไรหรือไม่ครับ หากมีการฟ้องช่วยจับภาพมาดูกันครับ

[benzdekhad]

ไม่ฟ้อง error อะไรขึ้นมาเลยครับ มันจะค้างซักพักหนึ่งแล้ว โปรแกรม excel มัน not responding ไปเลยครับ

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub Import2NextCol()

      Dim Filt$, Title$, FileText$
      Dim FileName$, N&, FirstEmpty&

      '//show dialog to import file
      '{Note: Office 2000 requires that
      '(*.bas; *.frm; *.cls;*.txt;*.log;*.frx)
      'be written twice, for later versions you
      'can delete the second instance}
      Filt = "VB Files (*.bas; *.frm; *.cls;*.txt;*.log;*.frx) " & _
             "(*.bas; *.frm; *.cls;*.txt;*.log;*.frx)," & _
             "*.bas;*.frm;*.cls;*.txt;*.log;*.frx"
      Title = "SELECT A FOLDER - DOUBLE-CLICK OR CLICK " & _
              "OPEN TO IMPORT - CANCEL TO QUIT"
      FileName = Application.GetOpenFilename _
                 (FileFilter:=Filt, FilterIndex:=5, Title:=Title)

      '//find first empty column
'      On Error GoTo IsBlankSheet    '< Error = nothing to find
      On Error Resume Next
      FirstEmpty = Cells.Find("*", SearchOrder:=xlByColumns, _
                              LookIn:=xlValues, SearchDirection:=xlPrevious). _
                   Column
      If FirstEmpty = 0 Then FirstEmpty = 1
      '//all columns contain text
      If FirstEmpty = 257 Then
            MsgBox "Sorry, no more columns on this sheet"
            Exit Sub
      End If

TextEntry:
      '//check there is a file to import
      If Dir(FileName) <> Empty Then
            '//import the text
            Application.ScreenUpdating = False
            Open (FileName) For Input As #1
            N = 1
            Do While Not EOF(1)
                 Line Input #1, FileText
                  Rows(N).Columns(FirstEmpty) = FileText
                  N = N + 1
            Loop      '< Loop until end of file
            Close #1

            '//tart up the spreadsheet
            ActiveWindow.DisplayGridlines = False
            With Cells
                  .Font.Size = 9
                  Columns.AutoFit
                  Rows.AutoFit
            End With

            '//goto the start of the entered text & exit sub
            Application.Goto Rows(1).Columns(FirstEmpty), scroll:=True
      End If
'      Exit Sub
'
'IsBlankSheet:
'      '//start in column 1
'      FirstEmpty = 1
'      '//clear the error & continue import
'      Resume TextEntry
End Sub

[benzdekhad]

import text file มาได้ปกติแล้วครับอาจารย์ขอบคุณมากเลยนะครับ ไม่ทราบว่า code เดิมติดปัญหาอะไรเหรอครับอาจารย์

[snasui]

ติดปัญหาเมื่อเกิด Error แล้วจะวน Loop ไม่รู้จบ ผมจึง Mark เป็น Comment ไว้ตามที่เห็นครับ

[benzdekhad]

ขอบคุณมากเลยนะครับอาจารย์ ตอนนี้ใช้ได้ดีมากเลยครับ ไม่ติดปัญหาใดๆแล้วครับ สามารถ import text file ได้ทุก file แล้ว