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
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 ยังไงดีคะ

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

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

ว้าย ขอโทษค่ะ เขียนผิด สับสนไปหน่อย อายจัง
ตามรูปนี้ บรรทัดสุดท้ายสิ้นสุดที่ 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
ลองแล้วยังไม่ได้ค่ะ บรรทัดสุดท้ายไม่ยอมมา ลองเปลี่ยนจาก
เป็น
ก็ยังไม่สำเร็จค่ะ

Re: merge file ด้วย VBA
Posted: Fri Dec 19, 2014 7:53 pm
by snasui

ตัวอย่าง 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
Re: merge file ด้วย VBA
Posted: Wed Dec 24, 2014 11:06 am
by snasui

อยู่ที่การกำหนดค่า Relative References ตามภาพด้านล่างครับ
Re: merge file ด้วย VBA
Posted: Wed Dec 24, 2014 3:05 pm
by nilrop