For Input As ใน vba ไปยังตัวแปรแบบไม่ครบทุกบรรทัด ทำได้ไหมครับ

[yopkub]

สวัสดีครับ

ขอสอบถามครับ จุดประสงค์ของผมคือ ต้องการโยน file ที่ open เข้ามาไปยังตัวแปรที่กำหนด
โดยผมไม่ต้องการโยนทุกบรรทัดในไฟล์ เพราะเจอไฟล์ใหญ่ มันจะนาน

ตัวอย่าง Code ที่โอนทุกบรรทัดเข้าตัวแปรชื่อ buf

Code: Select all

Dim buf As String
 strFile_Path_In = Cells(x,1)
 
 Open strFile_Path_In For input As #1 
  Line input #1,buf  
  Close #1

จาก Code ข้างต้น ผลลัพธ์คือ buf จะได้ ข้อมูลทุกบรรทัดที่อยุ่ในไฟล์ #1 มาทั้งหมด

แต่อยากขอคำแนะนำว่า หากผมต้องการแค่ 10 บรรทัด หรือสมมติว่า 200 ตัวอักษร
จะมีแนวทางเขียนยังไงครับ

ขอบคุณครับ

[snasui]

ตัวอย่างการ Loop ไปทีละบรรทัดครับ

Code: Select all

Dim buf As String, strFile_Path_In As String
Dim myFile As Integer, i As Integer
strFile_Path_In = "D:\Memo\ProgramInfo.txt"
myFile = FreeFile
Open strFile_Path_In For Input As myFile
Do Until EOF(myFile)
    Line Input #myFile, buf
    i = i + 1
    Cells(i, 2).Value = buf
Loop
Close myFile

[yopkub]

ขอบคุณมากครับ

ได้ไปลองแล้วอ่ะครับ แต่ผลทีได้ Cells(i,2) ก็ยังเป็นครบทุกบรรทัดอยู่ดีอ่ะครับ
เข้าใจมาก Line Input #myFile, buf ก็หมายถึงทำให้ buf รับข้อความทุกบรรทัดไม่ใช่เหรอครับพี่

ลองๆ เล่นหาไปเรื่อย ยังแยกไม่ได้ซักทีครับ TT
มาเต็มไฟล์ ตลอด

หากผมเข้าใจอะไรผิด รบกวนช่วยเพิ่มเติมให้ด้วยครับ

ขอบคุณครับ

[yopkub]

เพิ่มเติมครับ
ผมลองศึกษาเพิ่มตาม

http://codevba.com/office/read_text_fil ... HUFVdIzbIU
Credit : codevba website

แต่ผมติดตรง Type พอปรกาศใช้แล้ว Compile error พอมีคำแนะนำ เพิ่มเติมไหมครับ
ลองใส่ Public แล้วก็ไม่ได้ครับ

ขอบคุณครับ

[yopkub]

ล่าสุดใช้ Code ตามนี้ครับ
แต่เจอ Error

Compile error : Cannot define a Public user-defined type within an object module

รบกวยช่วยดูให้ทีครับ

Code: Select all

Type Record
 ID As Integer
 Name As String * 20
End Type

Sub Collect_data_from_NC_code()

    Dim myFile1 As Integer
    Dim text As String
    Dim buf As String
    Dim buftext As String
    Dim textline() As String
    Dim iFile As Integer
    
    iFile = FreeFile
    
    
    Const TxtIn1 = "(K:"
    Const TxtIn2 = "(B:"
    Const TxtIn3 = "(S:"
    Const TxtFin = "(ORIGIN 2 NOT USE)"
    Const TxtFin2 = "(END OF FOOTER)"
    Const TxtOut0 = "POPEN;"
    Const TxtOut1 = "DPRNT[SR01*"
    Const TxtOut2 = "DPRNT[SR02*"
    Const TxtOut3 = "DPRNT[SR03*"
    Const TxtOut4 = "DPRNT[SR04*START"
    Const TxtOut5 = "DPRNT[SR05*FINISH"
    Const TxtOut6 = "PCLOS;"
    Const TxtOut7 = "DPRNT[SR05*CLEAR];"
    Const TxtOut8 = "DPRNT[SR04*CLEAR];"

   
    Dim K As String
    Dim B As String
    Dim S As String
    Dim i As Double
    Dim TxtSR01 As String
    Dim TxtSR02 As String
    Dim TxtSR03 As String
    Dim TxtSR04 As String
    Dim TxtSR05 As String
    
    
    
    Dim X As Integer
    Dim C As Integer
    Dim J As Integer
    Dim IngPosition As Long
    
    

    For X = 9 To 38
    
    'Open file
    strFile_Path_In = Cells(X, 1)
    strFile_Path_Out = Cells(X, 11)
    
    'MsgBox (X)
    'MsgBox (Cells(X, 2))
    
    'strFile_Path_In = "D:\Mr.Jirawat\04_OA-support\02-MC\03_Other\Conprosys\Macro\Macro making\file1"
    'strFile_Path_Out = "D:\Mr.Jirawat\04_OA-support\02-MC\03_Other\Conprosys\Macro\Macro making\fileout2"
    
    'textline = Split(buf, vbLf)
    
    
    Open strFile_Path_In For Input As #iFile
      
    Dim MyRecord As Record
    
    Open strFile_Path_In For Random As #1 Len = Len(MyRecord)
    
    IngPosition = 20
    
    Get #1, lngPosition, buf
       
    Close #1
    
  
        textline = Split(buf, vbLf)
       
        
        For i = 0 To UBound(textline)
        
            text = text & textline(i) & vbLf
            If InStr(textline(i), TxtIn1) > 0 Then
                
                MsgBox (textline(i))
        
                TxtSR01 = Replace(textline(i), TxtIn1, "")
                TxtSR01 = Replace(TxtSR01, " ", "")
                TxtSR01 = Replace(TxtSR01, ")", "")
                
                MsgBox (textline(i))
            End If
            If InStr(textline(i), TxtIn2) > 0 Then
                MsgBox (textline(i))
                TxtSR02 = Replace(textline(i), TxtIn2, "")
                TxtSR02 = Replace(TxtSR02, " ", "")
                TxtSR02 = Replace(TxtSR02, ")", "")
                MsgBox (textline(i))
            End If
            If InStr(textline(i), TxtIn3) > 0 Then
                MsgBox (textline(i))
                TxtSR03 = Replace(textline(i), TxtIn3, "")
                TxtSR03 = Replace(TxtSR03, " ", "")
                TxtSR03 = Replace(TxtSR03, ")", "")
                MsgBox (textline(i))
                
                
            End If
            
            If InStr(textline(i), TxtFin) > 0 Then
                ' Found line to insert
                MsgBox (textline(i))
                text = text & TxtOut0 & vbLf
                text = text & TxtOut7 & vbLf
                text = text & TxtOut1 & TxtSR01 & "];" & vbLf
                text = text & TxtOut2 & TxtSR02 & "];" & vbLf
                text = text & TxtOut3 & TxtSR03 & "];" & vbLf
                text = text & TxtOut4 & "];" & vbLf
                text = text & TxtOut6 & vbLf
                
            End If
          
            'If InStr(textline(i), TxtFin2) > 0 Then
                ' Found line to insert
                'text = text & TxtOut0 & vbLf
                'text = text & TxtOut8 & vbLf
                'text = text & TxtOut1 & TxtSR01 & "];" & vbLf
                'text = text & TxtOut2 & TxtSR02 & "];" & vbLf
                'text = text & TxtOut3 & TxtSR03 & "];" & vbLf
                'text = text & TxtOut5 & "];" & vbLf
                'text = text & TxtOut6 & vbLf
                
            'End If
            
        'MsgBox (textline(1))
        
        Next i
        
      'MsgBox (text)
           
           
    Open strFile_Path_Out For Output As #1
    Print #1, text
    MsgBox ("Endloop")
    text = ""
    Close #1
     
     
 
        'Range("A1").Value = Mid(text, K + 3, 5)
        'Range("A2").Value = Mid(text, B + 3, 2)
        'Range("A3").Value = Mid(text, S + 3, 4)
        
    Next X
    
        
End Sub

[snasui]

Code ที่ผมตอบไปสามารถทำทีละบรรทัดกับ Text File ที่ผมมีครับ

ตัวอย่างเพิ่มเติม Read Text File Line by Line

กรุณาถามพร้อมด้วยไฟล์แนบที่เป็นไฟล์โปรแกรมและไฟล์ต้นทางตัวล่าสุดที่ได้นำ Code ไปใช้แล้วยังติดปัญหาจะได้ช่วยทดสอบให้ได้ครับ

[yopkub]

ขอบคุณมากครับ ไฟล์ตามแนบครับ

[yopkub]

เพิ่มเติม อันนี้คือไฟล์ไว้สำหรับ Input ครับ

[snasui]

ช่วยทำไฟล์ผลลัพธ์ที่ต้องการพร้อมอธิบายเงื่อนไขทั้งหมดที่ทำให้ได้ผลลัพธ์เช่นนั้นมาด้วยครับ

[yopkub]

ขอโทษที่ให้ข้อมูลไม่ครบครับ

ผลลัพธ์ที่ผมต้องการคือ ให้
ข้อมูล
POPEN;
DPRNT[SR05*CLEAR];
DPRNT[SR01*01200]; <---- เอาค่า 01200 มาจากบรรทัดที่ 5
DPRNT[SR02*61]; <---- เอาค่า 61 มาจากบรรทัดที่ 6
DPRNT[SR03*KGS2]; <--- เอาค่า KGS2 มาจากบรรทัดที่ 7
DPRNT[SR04*START];
PCLOS;

ไปเพิ่มหลังบรรทัดที่ 13 -->(ORIGIN 2 NOT USE) ของไฟล์ Input เข้าไปครับ

ตัวอย่างไฟล์ก่อนทำ (ผมตัดมาแค่ช่วงต้นๆ นะครับ เพราะส่วนที่ต้องการเพิ่มแค่ช่วงต้นๆไฟล์)

Code: Select all

%
(PROGRAM WAS IMPLEMENTED)
(START OF HEADER)
(INFOMATION)
(ORDER:  3 )
(K:01200        )
(B:61           )
(S:KGS2         )
(MAC:DC5_NEW_BG )
(TBL:DC5        )
(KN-S/10093     )
(M10MS3         )
(ORIGIN 1 X0.000 Y0.000 Z850.000)
(ORIGIN 2 NOT USE)


(CANCEL H/S MODE <DNC>)
M589(H/S MODE OFF<DNC>)
(AAC TO 1800)
G65P8500T1800
(ATC M10MS3 WITH R)
G65P8600T23R5.00
G65P8800(MIRROR.CANSEL)
(NOT.USE2ND.GENTEN)
(CHANGE ANGLE FOR MEASURE)
G65P8351A0.C0.(FOR AT1800)
S1000(CHANGE S-CORD FOR MESURE)
(MESURE TOOL AT BEFORE)
#505=0.30(BEF RIMIT)
G65P8211R5.00T5.00J0.00M0.(MEASURER OF LENGTH)
(CHANGE DIRECTION)
G65P8350A70.000C110.000
(1ST RETURN TO ORIGIN)
G65P8900
(SET TO OFFSET)
G65P8020D23
(F1FEED HIGH/SPEED)
G65P8090I350I650I1400I1400I1400I1450I15000I1000J1975
(HIGH SPEED MODE)
M588S1.(H/S FOR PERFECT FINISH)
(SET OF COOLANT)
M51(GAIB.AIR)
(END OF HEADER)
G01
M03
G91G01Z-53.29F0
X58.419Y335.691
Z-228.597
X14.463Y-39.736Z-15.391F7
X1.607Y-4.415Z-1.71F1
X.154Y-.021Z.065F6
X.235Y-.001Z.025
X.234Y.013Z-.011
X.234Y.022Z-.033
X.135Y.018Z-.034
X.099Y.015Z-.028
X.234Y.041Z-.082
X.233Y.049Z-.099

ตัวอย่างไฟล์หลังผ่าน Macro

Code: Select all

(PROGRAM WAS IMPLEMENTED)
(START OF HEADER)
(INFOMATION)
(ORDER:  3 )
(K:01200        )
(B:61           )
(S:KGS2         )
(MAC:DC5_NEW_BG )
(TBL:DC5        )
(KN-S/10093     )
(M10MS3         )
(ORIGIN 1 X0.000 Y0.000 Z850.000)
(ORIGIN 2 NOT USE)
POPEN;
DPRNT[SR05*CLEAR];
DPRNT[SR01*01200];
DPRNT[SR02*61];
DPRNT[SR03*KGS2];
DPRNT[SR04*START];
PCLOS;


(CANCEL H/S MODE <DNC>)
M589(H/S MODE OFF<DNC>)
(AAC TO 1800)
G65P8500T1800
(ATC M10MS3 WITH R)
G65P8600T23R5.00
G65P8800(MIRROR.CANSEL)
(NOT.USE2ND.GENTEN)
(CHANGE ANGLE FOR MEASURE)
G65P8351A0.C0.(FOR AT1800)
S1000(CHANGE S-CORD FOR MESURE)
(MESURE TOOL AT BEFORE)
#505=0.30(BEF RIMIT)
G65P8211R5.00T5.00J0.00M0.(MEASURER OF LENGTH)
(CHANGE DIRECTION)
G65P8350A70.000C110.000
(1ST RETURN TO ORIGIN)
G65P8900
(SET TO OFFSET)
G65P8020D23
(F1FEED HIGH/SPEED)
G65P8090I350I650I1400I1400I1400I1450I15000I1000J1975
(HIGH SPEED MODE)
M588S1.(H/S FOR PERFECT FINISH)
(SET OF COOLANT)
M51(GAIB.AIR)
(END OF HEADER)
G01
M03
G91G01Z-53.29F0
X58.419Y335.691
Z-228.597
X14.463Y-39.736Z-15.391F7
X1.607Y-4.415Z-1.71F1
X.154Y-.021Z.065F6
X.235Y-.001Z.025
X.234Y.013Z-.011
X.234Y.022Z-.033
X.135Y.018Z-.034
X.099Y.015Z-.028
X.234Y.041Z-.082
X.233Y.049Z-.099

[yopkub]

เพิ่มเติมครับ ผมจะส่งไฟล์ที่ผมทำได้ แต่เป็นแบบ Copy ทั้งไฟล์ ซึ่งปัญหาคือ ถ้าเจอไฟล์ที่มันมีขนาดใหญ่ (หลายบรรทัดมากๆ) จังหวะที่มัน Copy file ลงในตัวแปร buf ที่ผมตั้งไว้มันจะนานมากๆๆๆๆ ผมจึงตั้งกรทู้เพื่อถามว่า จะมีการ copy Line แค่ประมาณ 20 บรรทัดแรกได้ไหม ครับ
หลักการของโปรแกรมคือ
1.วางไฟล์ไว้ให้ตรงกับ Url ที่กำหนดใน Sheet (Input file Path)
2. แล้วกดปุ่ม Start Macro
3. ผลที่ได้คือ มันจะเอาข้อมูล บรรทัดที่ 5,6,7 (หลัง K: , B: , S: ตามลำดับ) เพื่อจะมาพิมพ์เพิ่มพวกข้อความ "DPRNT" ตามที่ผมกำหนดลงไป หลังบรรทัดที่ 13 (ตามที่ผมยกตัวอย่างไว้ข้างต้น ของเม้นก่อนหน้านี่ครับ)
ซึ่งหลักการเขียนคือ
3.1 จะ Copy file ทุกบรรทัดใส่ ตัวแปร Buf <-------****ปัญหาที่ทำให้เจอไฟล์ใหญ่แล้วค้างครับ
3.2 ใช้ตัวแปร buf ส่งค่าไปยังตัวแปร textline
3.3 ใช้ Textline เพื่อ ค้นหา (K: เพื่อจะตัดเอาข้อความหลังจากนั้นของบรรทัดนั้นมา
3.4 ทำหลักการเดียวกันกับ (B: และ (S: เพื่อให้ได้คำที่ต้องการมา
3.5 จากนั้นค้นหา (ORIGIN 2 NOT USE) แล้วเพิ่มข้อมูล
POPEN;
DPRNT[SR05*CLEAR];
DPRNT[SR01*01200]; <---- เอาค่า 01200 มาจากบรรทัดที่ 5
DPRNT[SR02*61]; <---- เอาค่า 61 มาจากบรรทัดที่ 6
DPRNT[SR03*KGS2]; <--- เอาค่า KGS2 มาจากบรรทัดที่ 7
DPRNT[SR04*START];
PCLOS;
3.6 จากนั้นก็จบไฟล์นี้ แล้วไปรันไฟล์ Input ตัวถัดไปที่อยู่ Path direct ที่วางไว้ครับ

4. ถ้าไฟล์ที่วางมีมากกว่า 1ไฟล์ มันจะวนรับทีละไฟล์ไปเรื่อยๆ จนครบครับ (ผมเลยใช้ตัวแปร X = 9 ถึง 38 ในการวน เพราะไฟล์ที่ผมจะวางจะไม่เกิน 29 ไฟล์ แน่ เลยวนรับแค่นั้นครับ)

[snasui]

ซึ่งปัญหาคือ ถ้าเจอไฟล์ที่มันมีขนาดใหญ่ (หลายบรรทัดมากๆ) จังหวะที่มัน Copy file ลงในตัวแปร buf ที่ผมตั้งไว้มันจะนานมากๆๆๆๆ ผมจึงตั้งกรทู้เพื่อถามว่า จะมีการ copy Line แค่ประมาณ 20 บรรทัดแรกได้ไหม ครับ

ได้เคยใส่ตัวนับเข้าไปใน Do...Loop เมื่อครับกำหนดแล้วค่อยออกจาก Do แล้วหรือไม่ครับ เช่น

Code: Select all

iCount = 0
Do Until EOF(myFile1)

    Line Input #myFile1, buf
    iCount = iCount + 1
    If iCount = 50 Then Exit Do
Loop
Close #1

[yopkub]

ได้ลองแล้วครับ
วนลูป แล้วให้ออก

แต่ตอนนี้ที่ผมเข้าใจ คือ

Line Input #myFile1, buf <---- มันหมายถึงการ Copy ทุกบรรทัดลงไปในตัวแปร Buf แล้วนะครับ

Code: Select all

Open strFile_Path_In For Input As myFile1
        L = 1
        MsgBox (buf)       
        iCount = 0
        
       Do Until EOF(myFile1)             
            MsgBox (iCount)
            Line Input #myFile1, buf
            
            MsgBox (buf)
            
            iCount = iCount + 1
            
            If iCount = 3 Then Exit Do
                                     
            MsgBox ("Finish1")
            
        Loop  
        Close #1

เพราะเข้ารอบแรก เมื่อปริ้น buf ดู มันก็ออกมาครบทุกบรรทัดเลยอ่ะครับ

[snasui]

Line Input #myFile1, buf <---- มันหมายถึงการ Copy ทุกบรรทัดลงไปในตัวแปร Buf แล้วนะครับ

ขึ้นกับ Text File ครับ ไม่ใช่ว่าจะเป็นเป็นเช่นนี้เสมอไป ยกตัวอย่างไฟล์ที่คุณ yopkub แนบมาไม่แยกเป็นบรรทัด แต่ไฟล์ที่ผมสร้างขึ้นมาหรือไฟล์ทั่วไปมีการแยกเป็นรายบรรทัด

ข้อสังเกตง่าย ๆ ว่าโดยทั่วไปจะมีหลายบรรทัด Code โดยส่วนใหญ่แม้แต่ Code ที่คุณ yopkub ยกมาถามจะมีการ Loop ด้วย Do เพื่อไปยังแต่ละบรรทัด ไม่เช่นนั้นก็ไม่จำเป็นต้อง Loop ด้วย Do แต่อย่างใดครับ

Code ด้านล่างนี้ผมทำมาเป็นตัวอย่างของการแทรกข้อความตามที่เขียนแจ้งมา โดยจะแสดงผลในเซลล์ A31 ลองนำไปประยุกต์ใช้กับงานจริงแล้วสังเกตว่าช่วยให้เร็วขึ้นหรือไม่ครับ

Code: Select all

Dim hf As Integer
Dim lines As String, buf As String
Dim x As String, y As String, strInsert As String
strInsert = "POPEN;" & vbLf & _
        "DPRNT[SR05*CLEAR];" & vbLf & _
        "DPRNT[SR01*@];" & vbLf & _
        "DPRNT[SR02*#];" & vbLf & _
        "DPRNT[SR03*KGS2];" & vbLf & _
        "DPRNT[SR04*START];" & vbLf & _
        "PCLOS;"
hf = FreeFile
Open "C:\Users\santipon\Downloads\Temp\Forum\KGS001_" For Input As #hf
    Line Input #hf, buf
    lines = VBA.Left$(buf, 500)
Close #hf
x = Application.Trim(Mid(lines, InStr(lines, "(B:") + 3, 13))
y = Application.Trim(Mid(lines, InStr(lines, "(K:") + 3, 13))
strInsert = Replace(strInsert, "#", x)
strInsert = Replace(strInsert, "@", y)
buf = Replace(buf, "(ORIGIN 2 NOT USE)", "(ORIGIN 2 NOT USE)" & vbLf & strInsert)
Cells(31, 1).Value = buf

[yopkub]

ขอบคุณมากๆครับ

ผมลองเอา Concept ที่ให้ไปประยุกค์ ใช้งานกับ Code จริงผม (ปรับจาก Code เดิมทั้งหมด)
ตอนนี้ได้ตามเป้าหมายที่วางไว้แล้วครับ
แล้วไฟล์ที่นานก็เร็วขึ้นมากครับ จาก ชม.กว่าๆ เหลือแค่ไม่กี่นาทีครับ

ขอบคุณสำหรับคำแนะนำครับพี่