Page 2 of 2

Re: merge file ด้วย VBA

Posted: Sun Dec 14, 2014 11:30 pm
by nilrop
ติดปัญหาอีกนิดนึงค่ะ ถ้าหากว่า ข้อมูลจริงๆจนถึงบรรทัดสุดท้ายของแต่ละไฟล์นั้นอยู่ที่คอลัมน์ S แต่ข้อมูลทั้งหมดยาวไปจนถึงคอลัมน์ Q จะใช้คอลัมน์ไหนอ้างอิงคะ

พอเปลี่ยนเป็น S ก็ดึงให้หมดจนบรรทัดสุดท้ายจริง แต่ก็สิ้นสุดที่ S ส่วนข้อมูลในคอลัมน์ที่เหลือถึง Q ไม่ดึงมาให้

พอเปลี่ยนเป็น Q ก็ดึงข้อมูลให้หมดจนถึงคอลัมน์ Q แต่บรรทัดสุดท้ายที่อยู่ที่คอลัมน์ S ไม่ถูกเอามาด้วย

ควรแก้ code ยังไงดีคะ

Re: merge file ด้วย VBA

Posted: Mon Dec 15, 2014 12:37 am
by nilrop
ลืมแนบไฟล์ตัวอย่างค่ะ

Re: merge file ด้วย VBA

Posted: Thu Dec 18, 2014 9:46 pm
by nilrop
:roll: เอ่อ ไม่แน่ใจว่าทำอะไรผิดกฎไหม แต่ได้ลองไปหาคำตอบเอาเองแล้ว ก็ยังจนปัญญาอยู่ดีค่ะ ยังไม่สามารถรวมไฟล์จนถึงบรรทัดสุดท้ายได้จริงๆเลยค่ะ รบกวนผู้รู้ชี้แนะอีกครั้งค่ะ:oops:

ป.ล. อีกปัญหานึง เวลาบันทึกสูตรลง macro เช่น =B2 แล้ว ตอน run macro กลับขึ้นเป็น =RC[-1] แทน เพราะสาเหตุอะไรเหรอคะ งงค่ะ :?: :?: :?:

ขอบคุณมากๆๆค่ะที่ช่วยเหลือ :thup: :cp:

Re: merge file ด้วย VBA

Posted: Thu Dec 18, 2014 10:01 pm
by snasui
nilrop wrote:ติดปัญหาอีกนิดนึงค่ะ ถ้าหากว่า ข้อมูลจริงๆจนถึงบรรทัดสุดท้ายของแต่ละไฟล์นั้นอยู่ที่คอลัมน์ S แต่ข้อมูลทั้งหมดยาวไปจนถึงคอลัมน์ Q จะใช้คอลัมน์ไหนอ้างอิงคะ

พอเปลี่ยนเป็น S ก็ดึงให้หมดจนบรรทัดสุดท้ายจริง แต่ก็สิ้นสุดที่ S ส่วนข้อมูลในคอลัมน์ที่เหลือถึง Q ไม่ดึงมาให้

พอเปลี่ยนเป็น Q ก็ดึงข้อมูลให้หมดจนถึงคอลัมน์ Q แต่บรรทัดสุดท้ายที่อยู่ที่คอลัมน์ S ไม่ถูกเอามาด้วย

ควรแก้ code ยังไงดีคะ
:D ที่อธิบายมานี้คอลัมน์ S และ Q คอลัมน์ไหนอยู่ก่อนหรืออยู่หลัง ลองทบทวนแล้วอธิบายมาใหม่ครับ

Re: merge file ด้วย VBA

Posted: Fri Dec 19, 2014 10:36 am
by nilrop
:D ที่อธิบายมานี้คอลัมน์ S และ Q คอลัมน์ไหนอยู่ก่อนหรืออยู่หลัง ลองทบทวนแล้วอธิบายมาใหม่ครับ

:oops: :oops: ว้าย ขอโทษค่ะ เขียนผิด สับสนไปหน่อย อายจัง

ตามรูปนี้ บรรทัดสุดท้ายสิ้นสุดที่ M ส่วนคอลัมน์สุดท้ายอยู่ที่ Q ค่ะ

[img][img]http://upic.me/i/4o/va5lp.jpg[/img][/img]

Re: merge file ด้วย VBA

Posted: Fri Dec 19, 2014 10:43 am
by niwat2811
ลองปรับโค๊ดเป็นแบบนี้ดูครับ ว่าใช้ได้ตามต้องการไหม

Code: Select all

Sub simpleXlsMerger4()
    
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
     
    Set dirObj = mergeObj.Getfolder(Sheets("Sheet4").Range("A1"))
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)
        bookList.Sheets(1).Range("A1:Q" & bookList.Sheets(1).Range("I65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(3).Activate
        If Range("Q65536").End(xlUp).Offset(1, -16).Row = 1 Then
            Range("a1").PasteSpecial
        Else
            Range("Q65536").End(xlUp).Offset(2, -16).PasteSpecial
        End If
        Application.CutCopyMode = False
        bookList.Close False
    Next
    Application.ScreenUpdating = True
End Sub

Re: merge file ด้วย VBA

Posted: Fri Dec 19, 2014 2:32 pm
by nilrop
niwat2811 wrote:ลองปรับโค๊ดเป็นแบบนี้ดูครับ ว่าใช้ได้ตามต้องการไหม

Code: Select all

Sub simpleXlsMerger4()
    
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
     
    Set dirObj = mergeObj.Getfolder(Sheets("Sheet4").Range("A1"))
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)
        bookList.Sheets(1).Range("A1:Q" & bookList.Sheets(1).Range("I65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(3).Activate
        If Range("Q65536").End(xlUp).Offset(1, -16).Row = 1 Then
            Range("a1").PasteSpecial
        Else
            Range("Q65536").End(xlUp).Offset(2, -16).PasteSpecial
        End If
        Application.CutCopyMode = False
        bookList.Close False
    Next
    Application.ScreenUpdating = True
End Sub

ลองแล้วยังไม่ได้ค่ะ บรรทัดสุดท้ายไม่ยอมมา ลองเปลี่ยนจาก

Code: Select all

Range("I65536")
เป็น

Code: Select all

Range("M65536")
ก็ยังไม่สำเร็จค่ะ :shock:

Re: merge file ด้วย VBA

Posted: Fri Dec 19, 2014 7:53 pm
by snasui
:D ตัวอย่าง Code ครับ

Code: Select all

Sub simpleXlsMerger4()

    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    
    Application.ScreenUpdating = False
    
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
    Set dirObj = mergeObj.Getfolder(Sheets("Sheet4").Range("A1"))
    Set filesObj = dirObj.Files
    
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)
        bookList.Sheets(1).Range("A1:Q" & bookList.Sheets(1).Range("M65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(3).Activate
            If Range("M65536").End(xlUp).Row = 1 Then
                Range("a1").PasteSpecial
            Else
                Range("M65536").End(xlUp).Offset(1, -12).PasteSpecial
            End If
            Application.CutCopyMode = False
            bookList.Close False
    Next
    
    Application.ScreenUpdating = True

End Sub

Re: merge file ด้วย VBA

Posted: Wed Dec 24, 2014 10:56 am
by nilrop
มารายงานผลค่ะ ได้ตามที่ต้องการ ขอบคุณมากๆๆนะคะที่ให้คำแนะนำ :cp: :thup: :cp: :thup:

ป.ล. อีกปัญหานึง เวลาบันทึกสูตรลง macro เช่น =B2 แล้ว ตอน run macro กลับขึ้นเป็น =RC[-1] แทน เพราะสาเหตุอะไรเหรอคะ งงค่ะ
อันนี้ยังงงอยู่เลยค่ะ :oops: :oops:

Re: merge file ด้วย VBA

Posted: Wed Dec 24, 2014 11:06 am
by snasui
:D อยู่ที่การกำหนดค่า Relative References ตามภาพด้านล่างครับ

Re: merge file ด้วย VBA

Posted: Wed Dec 24, 2014 3:05 pm
by nilrop
snasui wrote::D อยู่ที่การกำหนดค่า Relative References ตามภาพด้านล่างครับ
อ้ออย่างนี้นี่เอง สงสัยมือไปกดโดนค่ะ ไม่ได้ตั้งใจจะกำหนดแบบนี้เลย ขอบคุณมากเลยค่ะ :D :D :thup: :thup: