merge file ด้วย VBA

[nilrop]

สวัสดีค่ะ มีปัญหาเรื่อง excel สอบถามดังนี้ค่ะ

อยาก merge ไฟล์ หลายๆไฟล์ ให้กลายเป็นไฟล์เดียวกัน จากที่หาความรู้ใน google มา ได้ code VBA มาจาก web ต่างประเทศ จะเอามาประยุกต์ใช้ดู แต่ปรากฎว่าผลลัพธ์ที่รวมสำเร็จแล้ว ออกมาไม่ครบทุกบรรทัดค่ะ

รบกวนถามผู้รู้ว่า ต้องปรับ CODE เป็นอย่างไรคะ จึงจะให้รวมออกมาให้ครบทุกบรรทัด (ไฟล์ที่จะให้รวมกัน ดาวน์โหลดออกมาจากระบบฐานข้อมูล ไม่ได้ปรับแต่งใดๆๆทั้งสิ้นค่ะ)

Code: Select all

Sub simpleXlsMerger()
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("C:\Users\Desktop\test")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
 

Range("A1:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
 

Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub

จาก code นี้ สิ่งที่ต้องปรับเองคือ C:\Users\Desktop\test ซึ่งเป็นที่อยู่ของไฟล์นั้นๆค่ะ

ขอบคุณมากค่ะ

[ajsudkedt]

http://www.snasui.com/download/file.php?id=6960
ไม่รู้ว่าตัวนี้จะตอบโจทย์ได้ไหม ลองดูครับ

[nilrop]

http://www.snasui.com/download/file.php?id=6960
ไม่รู้ว่าตัวนี้จะตอบโจทย์ได้ไหม ลองดูครับ

ลองดูแล้ว มันออกมาแต่หัวรายงาน แต่รายละเอียดไม่มีให้เลยค่ะ

[ajsudkedt]

ต้องเอาหัวรายงานมาใส่บรรทัดของแต่ละรายละเอียดครับ

[nilrop]

ต้องเอาหัวรายงานมาใส่บรรทัดของแต่ละรายละเอียดครับ

ขยายความหน่อยได้ไหมคะ ว่าต้องจัการอย่างไรจึงจะสะดวกสุด ถ้า copy แปะ ทุกไฟล์ User บอกไม่ไหวค่ะ

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

หรือมีวิธีอื่นที่ดีกว่านี้ ขอคำชี้แนะด้วย ขอบคุณมากค่ะ

[ajsudkedt]

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

[nilrop]

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

ตั้งใจว่าจะต้องดัดแปลงข้อมูลอีกครั้ง โดยใช้ macro ช่วย แต่ต้องทำหลังจากที่รวมไฟล์ได้แล้วค่ะ แต่จะให้มาทำทีละไฟล์ 30 ไฟล์ User ไม่ไหวค่ะ

คิดเองว่า ข้อมูลมันมีบรรทัดว่างอยู่ code เลยไม่รู้ว่าบรรทัดไหนเป็นบรรทัดสุดท้าย ประมาณนี้ไหมคะ ขอบคุณท่านมากค่ะ

[snasui]

แนบไฟล์ที่เขียน Code พร้อมตัวอย่างคำตอบที่ต้องการมาด้วยครับ

[nilrop]

แนบไฟล์ตัวอย่าง result คือ รายงานที่ต้องการ ส่วน merge test คือ ไฟล์ที่มี code ค่ะ

ขอบคุณมากค่ะ

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub simpleXlsMerger()
    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("C:\Users\Administrator.WIN-QU797C1H8M2\Desktop\test")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)
        bookList.Sheets(1).Range("A1:O" & bookList.Sheets(1).Range("O65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(1).Activate
        Range("O65536").End(xlUp).Offset(1, -14).PasteSpecial
        Application.CutCopyMode = False
        bookList.Close False
    Next
    Application.ScreenUpdating = True
End Sub

[nilrop]

ขอบพระคุณมากค่ะ ได้ครบถ้วนตามที่ต้องการเลยค่ะ

อยากทราบเป็นความรู้หน่อยค่ะ ช่วยอธิบายโค้ดเดิมให้หน่อยได้ไหมคะ มันใช้ไม่ได้เพราะมีปัญหาอะไร จะเกี่ยวกับคอลัมภ์ไหม เพราะอันใหม่นี้ปรับตรงคอลัมภ์เป็น o และช่วง offset ด้วยค่ะ มันส่งผลยังไงบ้างคะ

ความรู้เรื่อง VBA ยังไม่ชำนาญค่ะ เพิ่งเริ่มจะหัดเองค่ะ

[nilrop]

ลืมอีกประเด็นหนึ่งคือ ไฟล์ข้อมูลมีการ merge cell + wrap text ไว้ด้วย ถ้าจะให้ตอนรวมไฟล์ ยกเลิกการ merge พวกนี้ไปด้วยเลยได้ไหมคะ เพิ่ม code ตรงไหนได้บ้าง ถ้าไม่งั้นคงต้องกดยกเลิกเองค่ะ ก็ยังพอไหวค่ะไฟล์เดียว

ขอบคุณอีกครั้งค่ะ

[snasui]

มันใช้ไม่ได้เพราะมีปัญหาอะไร จะเกี่ยวกับคอลัมภ์ไหม

เกี่ยวกับคอลัมน์โดยตรงครับ

เพราะอันใหม่นี้ปรับตรงคอลัมภ์เป็น o

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

.End(xlUp).Row เป็นการหาบรรทัดสุดท้ายที่มีข้อมูล

.Offset(1, -14) หมายถึงให้ลงไปด้านล่าง 1 บรรทัดและไปด้านซ้าย 14 คอลัมน์

[snasui]

ไฟล์ข้อมูลมีการ merge cell + wrap text ไว้ด้วย ถ้าจะให้ตอนรวมไฟล์ ยกเลิกการ merge พวกนี้ไปด้วยเลยได้ไหมคะ เพิ่ม code ตรงไหนได้บ้าง

ให้เขียนมาเองก่อน หากเขียนเองไม่ให้ให้ลองบันทึก Macro แล้วปรับใช้ ติดตรงไหนค่อยถามกันต่อครับ

[nilrop]

จะลองใช้ macro เขียนดูก่อนค่ะ แล้วจะมารายงานผลให้ทราบ ขอบคุณมากนะคะ


edit: ใช้ macro ช่วย สำเร็จแล้วค่ะ เว็บนี้มีประโยชน์มากเลย ขอบคุณที่แชร์พื้นที่ให้ความรู้กันนะคะ

[nilrop]

รบกวนถามเพิ่มเติม
1. ถ้าหาก เปลี่ยนที่อยู่ของโฟลเดอร์ให้เป็น Range A1 แล้วค่อยก๊อปปี้ที่อยู่มาวางไว้ที่ A1 แทนที่จะต้องไปแก้ใน code มันก็รวมไฟล์ให้เหมือนกัน แต่มันจะรวมไว้ที่ sheet 1 เสมอ แต่ถ้าอยากให้มันไปรวมไว้ที่ sheet 2 ต้องเพิ่มตรงไหนบ้าง ลองเติม Sheets("Sheet2").Select แต่ไม่ได้ผลค่ะ

2.ถ้าข้อมูลมีคอลัมน์ยาวกว่าคอลัมน์ O แล้วต้องแก้ตรง Offset(1, -14) ด้วยหรือไม่คะ

ขอบคุณมากๆค่ะ

[snasui]

1. ถ้าหาก เปลี่ยนที่อยู่ของโฟลเดอร์ให้เป็น Range A1 แล้วค่อยก๊อปปี้ที่อยู่มาวางไว้ที่ A1 แทนที่จะต้องไปแก้ใน code มันก็รวมไฟล์ให้เหมือนกัน แต่มันจะรวมไว้ที่ sheet 1 เสมอ แต่ถ้าอยากให้มันไปรวมไว้ที่ sheet 2 ต้องเพิ่มตรงไหนบ้าง ลองเติม Sheets("Sheet2").Select แต่ไม่ได้ผลค่ะ

ตัวอย่างการปรับ Code ให้แสดงที่ Sheet2 ครับ

Code: Select all

Sub simpleXlsMerger()
    'Sheets("Sheet2").Select
    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("Sheet2").Range("A1"))
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)
        bookList.Sheets(1).Range("A1:O" & bookList.Sheets(1).Range("O65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(2).Activate
        If Range("O65536").End(xlUp).Offset(1, -14).Row = 2 Then
            Range("a1").PasteSpecial
        Else
            Range("O65536").End(xlUp).Offset(1, -14).PasteSpecial
        End If
        Application.CutCopyMode = False
        bookList.Close False
    Next
    Application.ScreenUpdating = True
End Sub

2.ถ้าข้อมูลมีคอลัมน์ยาวกว่าคอลัมน์ O แล้วต้องแก้ตรง Offset(1, -14) ด้วยหรือไม่คะ

ไม่ใช่แก้แค่ตรง Offset เท่านั้น จะต้องแก้ bookList.Sheets(1).Range("A1:O" & bookList.Sheets(1).Range("O65536").End(xlUp).Row).Copy และ Range("O65536").End(xlUp).Offset(1, -14).Row ครับ

[nilrop]

ลองแก้แบบนี้ค่ะ พอใช้ได้ไหมคะ ภายใต้เงื่อนไข
1. อยากให้แสดงข้อมูลรวมที่ sheet5
2. ข้อมูลแต่ละไฟล์สิ้นสุดที่คอลัมน์ Q
3. อยากให้รวมข้อมูลตั้งแต่แถว 1

Code: Select all

Set dirObj = mergeObj.Getfolder(Sheets("Sheet5").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("Q65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(5).Activate
        If Range("Q65536").End(xlUp).Offset(1, -16).Row = 1 Then
            Range("a1").PasteSpecial
        Else
            Range("Q65536").End(xlUp).Offset(1, -16).PasteSpecial
        End If

ป.ล.

• ThisWorkbook.Worksheets(5).Activate

อันนี้คือ บอกลำดับของชีท หรือเปล่าคะ ถ้าสมมติว่ามี sheet ทั้งหมด 10 sheet แล้ว sheet5 อยู่ลำดับที่เท่าไหร่ ก็ต้องแก้ตามนั้นหรือเปล่าคะ เช่น sheet 5 อยู่ลำดับที่ 2 ก็แก้เป็นเลข 2 ถูกไหมคะ -- พอดีมือใหม่ VBA หาเหตุผลทำความเข้าใจเองค่ะ

ขอบคุณมากๆเลยค่ะ ได้ความรู้ขึ้นเยอะเลย

[snasui]

ลองก่อนเลยครับ จะได้ตอบตัวเองได้ว่าถูกหรือไม่ถูก ติดแล้วค่อยถามกันครับ

ตัวเลขในวงเล็บของ Worksheets(Number) เป็นลำดับของชีทเรียงจากซ้ายไปขวา เข้าใจถูกต้องแล้วครับ

[nilrop]

เรียบร้อยค่ะ ได้ผลตามต้องการ ขอบคุณมากๆนะคะ