:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

ต้องการรวมหลายๆไฟล์ เป็นไฟล์เดียว แต่ Code ดึงข้อมูลไม่ครบ

Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่

Post a reply


This question is a means of preventing automated form submissions by spambots.
Smilies
:D :thup: :cp: :flw: :rz: :sg: :tt: :) ;) :( :o :shock: :? 8-) :lol: :x :P :oops: :cry: :evil: :twisted: :roll: :!: :?: :idea: :arrow: :ard: :arl: :aru: :| :mrgreen: :geek: :ugeek:

BBCode is ON
[img] is ON
[url] is ON
Smilies are ON

Topic review
   

Expand view Topic review: ต้องการรวมหลายๆไฟล์ เป็นไฟล์เดียว แต่ Code ดึงข้อมูลไม่ครบ

Re: ต้องการรวมหลายๆไฟล์ เป็นไฟล์เดียว แต่ Code ดึงข้อมูลไม่ครบ

#5

by pori » Mon Jan 30, 2017 9:14 am

ขอบพระคุณอาจารย์มากๆค่ะ พอดีก่อนหน้านี้ลองแก้เอง โดยไปเปลี่ยนจากคอลัมน์ O เป็น M ทั้งหมด แต่ข้อมูลมันไม่เห็นมาเลยค่ะ ก็เลยงงๆไป คงทำผิด พออาจารย์แก้ให้เป็น B ทีนี้มาครบเลยค่ะ ขอบคุณมากเลยค่ะ

Re: ต้องการรวมหลายๆไฟล์ เป็นไฟล์เดียว แต่ Code ดึงข้อมูลไม่ครบ

#4

by snasui » Fri Jan 27, 2017 6:49 pm

:D ตัวอย่างการปรับ Code หากมีปัญหาอื่นใดให้ปรับ Code มาเองก่อนเสมอ ติดตรงไหนค่อยถามกันต่อครับ

Code: Select all

'--Other code
If Range("B65536").End(xlUp).Offset(1, -1).Row = 1 Then
    Range("a1").PasteSpecial
Else
    Range("B65536").End(xlUp).Offset(1, -1).PasteSpecial
End If
'--Other code

Re: ต้องการรวมหลายๆไฟล์ เป็นไฟล์เดียว แต่ Code ดึงข้อมูลไม่ครบ

#3

by pori » Fri Jan 27, 2017 10:24 am

ขอบคุณอาจารย์มากๆค่ะ ลองเอาไปใช้แล้ว แต่เหมือนว่าข้อมูลยังมาไม่ครบเลยค่ะ เพราะว่าบรรทัด *รวม ของแต่ละ sheet ไม่ยอมมาด้วยเลย อยากให้ดึงข้อมูลแต่ละไฟล์มาจนสุดบรรทัดนี้เลยค่ะ

แนบไฟล์ใหม่ค่ะ ได้แบบนี้
Attachments
รวมไฟล์ตัวอย่าง Code-แก้.xlsm
(48.37 KiB) Downloaded 9 times

Re: ต้องการรวมหลายๆไฟล์ เป็นไฟล์เดียว แต่ Code ดึงข้อมูลไม่ครบ

#2

by snasui » Thu Jan 26, 2017 7:21 pm

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

Code: Select all

'--Other code
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
    bookList.Sheets(1).UsedRange.Copy
    ThisWorkbook.Worksheets(1).Activate
    If Range("O65536").End(xlUp).Offset(1, -14).Row = 1 Then
        Range("a1").PasteSpecial
    Else
        Range("O65536").End(xlUp).Offset(1, -14).PasteSpecial
    End If
    Application.CutCopyMode = False
    bookList.Close False
Next
'--Other code

ต้องการรวมหลายๆไฟล์ เป็นไฟล์เดียว แต่ Code ดึงข้อมูลไม่ครบ

#1

by pori » Thu Jan 26, 2017 3:44 pm

สวัสดีค่ะ

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

โดยใช้ Code ของเก่าที่เคยใช้อีกงานตามข้างล่างนี้ค่ะ แต่เจอปัญหา Code ดึงข้อมูลมาไม่ครบ เนื่องจาก บรรทัดสุดท้าย คอลัมน์สุดท้ายมันไม่มีข้อมูล Code เลยไม่ดึงมาให้ (ตามที่อยู่ใน sheet1) ซึ่งสิ่งที่ต้องการอยู่ในชีท "ผลลัพธ์ที่ต้องการ" ค่ะ รบกวนสอบถามว่าควรจะต้องแก้ Code เพิ่มเติมตรงไหน ถึงจะดึงข้อมูลได้ครบค่ะ

ขอบคุณมากๆที่ให้ช่วยคำแนะนำ

Code: Select all

Sub TestCode2()
              
    'Start to merge file
    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")
     
    'Range("A1") is file path, it can be changed  or filled path like  "C:\Users\Administrator\Desktop\test"
    'Range("A1:O) ==> O is the last column that contain data.If  your data is over than column O, you can change it
    'Offset(1, -14) is down 1 and left 14 -- change it too. (Å§ä» 1 ªèͧ ä»·Ò§«éÒ 14 ªèͧ ¶éÒ¢éÍÁÙÅÁÒ¡¡ÇèÒ O ¡çµéͧ¹ÑºA-O áÅéÇź1 á¡éàÅ¢àÍÒ)
    'ThisWorkbook.Worksheets(2).Activate à»ç¹ÅӴѺ¢Í§ªÕ·¨Ò¡«éÒ ¶éÒªÕ··ÕèÃÇÁÍÂÙèã¹ÅӴѺ·Õèà·èÒäËÃè¡çµéͧà»ÅÕè¹àÅ¢ÅӴѺ´éÇÂ
    
   Set dirObj = mergeObj.Getfolder(Sheets("Sheet1").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(1).Activate
        If Range("O65536").End(xlUp).Offset(1, -14).Row = 1 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

แนบไฟล์ตัวอย่างตามนี้ค่ะ

ข้อมูลดิบที่ต้องการรวมกันเป็นไฟล์เดียว
Attachments
ข้อมูลดิบที่ใช้.rar
(28.86 KiB) Downloaded 6 times
รวมไฟล์ตัวอย่าง Code.xlsm
(43.38 KiB) Downloaded 11 times

Top