:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup:

:!: โปรดทราบ :!:
  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

รวมชีทจากแต่ละไฟล์ที่อยู่ในแต่ละ Subfolder

ฟอรัมถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
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. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
niwat2811
Bronze
Bronze
Posts: 336
Joined: Thu Jan 06, 2011 12:51 pm
Excel Ver: 2016

รวมชีทจากแต่ละไฟล์ที่อยู่ในแต่ละ Subfolder

#1

Post by niwat2811 »

ต้องการรวมข้อมูลจากแต่ละชีทจาก D:/แยกรายภาค/ภาค 1, D:/แยกรายภาค/ภาค 2 จากทุก Subfolder มาต่อกันให้เป็นแต่ละไฟล์ใน
D:/สรุปภาค/ ตามตัวอย่างในไฟล์แนบครับ ไม่ทราบว่าควรปรับ Code อย่างไร Code อยู่ใน Module 1 ครับ

Code: Select all

Sub loopAllSubFolderSelectStartDirectory()

Call LoopAllSubFolders("D:\แยกรายภาค\")

End Sub
Sub LoopAllSubFolders(ByVal folderPath As String)

Dim fileName As String
Dim fullFilePath As String
Dim numFolders As Long
Dim folders() As String
Dim i As Long
Dim strThisOne As String
Dim strFile As String
Dim wbk As Workbook

If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.*", vbDirectory)

While Len(fileName) <> 0

    If Left(fileName, 1) <> "." Then
 
        fullFilePath = folderPath & fileName
 
        If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
            ReDim Preserve folders(0 To numFolders) As String
            folders(numFolders) = fullFilePath
            numFolders = numFolders + 1
        Else
             Set Wkb = Workbooks.Open(fileName:=folderPath & fileName)
             ActiveWorkbook.ActiveSheet.Copy After:=Workbooks("รวม.xlsm").Sheets(Workbooks("รวม.xlsm").Sheets.Count)
             ActiveWorkbook.Close
        End If
 
    End If
 
    fileName = Dir()

Wend

For i = 0 To numFolders - 1

    LoopAllSubFolders folders(i)
 
Next i

Call SaveMyWorkbook
Call Delete_Sheets

End Sub
Sub SaveMyWorkbook()
    Dim strThisOne As String
    Dim str As String
    Dim str1 As String
    Dim str2 As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim Name As String
    Set wbk = ActiveWorkbook
    strThisOne = wbk.FullName
    Name = ActiveSheet.Name
    str = Right(Name, Len(Name) - InStr(Name, "ภาค") + 1)
    strFile = "D:\แยกรายภาค\" & str & ".xlsx"
    Application.DisplayAlerts = False
    wbk.Save
    wbk.SaveAs fileName:=strFile, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    'Workbooks.Open strThisOne
    Call Delete_Sheets
End Sub
Sub Delete_Sheets()
Dim i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = Worksheets.Count To 2 Step -1
    Worksheets(i).Delete
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รวมชีทจากแต่ละไฟล์ที่อยู่ในแต่ละ Subfolder

#2

Post by snasui »

:D กรุณาแนบไฟล์ที่มีข้อมูลตัวอย่างเพื่อให้สะดวกต่อการทดสอบ ควรอธิบายด้วยว่า Code ที่เขียนมานั้นติดปัญหาตรงไหน อย่างไร จะได้เข้าถึงปัญหาโดยไวครับ
niwat2811
Bronze
Bronze
Posts: 336
Joined: Thu Jan 06, 2011 12:51 pm
Excel Ver: 2016

Re: รวมชีทจากแต่ละไฟล์ที่อยู่ในแต่ละ Subfolder

#3

Post by niwat2811 »

ความต้องการคือ พอกดปุ่มรวมชีท มาโครจะทำการดึงข้อมูลจาก D:/แยกรายภาค/ภาค 1/ภาค 1.xlsx มาวางที่ไฟล์รวมโดยทำการต่อชีทกันไปเรื่อย ๆ ซึ่งปัญหาที่ติดขัดคือพอรันตัวมาโครแล้ว ดึงข้อมูลชีทมาแค่ไฟล์แรก แล้วขึ้น Popup (ภาพที่ 2) และไม่ยอมดึงข้อมูลชีทจากไฟล์อื่น ๆ มาครับ (ภาพที่ 3 คือภาพที่ควรจะดีงมาให้ครบ) เลยไม่ทราบว่าจะแก้ไขปรับปรุง Code อย่างไรครับ
You do not have the required permissions to view the files attached to this post.
niwat2811
Bronze
Bronze
Posts: 336
Joined: Thu Jan 06, 2011 12:51 pm
Excel Ver: 2016

Re: รวมชีทจากแต่ละไฟล์ที่อยู่ในแต่ละ Subfolder

#4

Post by niwat2811 »

ขออนุญาตแนบไฟล์เพิ่มเติมครับ
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 29982
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รวมชีทจากแต่ละไฟล์ที่อยู่ในแต่ละ Subfolder

#5

Post by snasui »

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

Code: Select all

Sub Example()
    Dim FileSystem As Object
    Dim HostFolder As String
    Dim subFolder As Object
    Dim fPath As String
    Dim file As Object
    Dim twb As Workbook
    Dim wb As Workbook
    Dim sh As Worksheet, scSh As Worksheet
    Dim tgS As Worksheet
    
    HostFolder = "D:\แยกรายภาค"
    fPath = "D:\สรุปภาค\"
    Set FileSystem = CreateObject("Scripting.FileSystemObject")

    For Each subFolder In FileSystem.getfolder(HostFolder).subfolders
        Select Case subFolder.Name
            Case "ภาค 1"
                Set twb = Workbooks.Open(fPath & "ภาค 1.xlsx")
            Case "ภาค 5"
                Set twb = Workbooks.Open(fPath & "ภาค 5.xlsx")
            Case "ภาค 10"
                Set twb = Workbooks.Open(fPath & "ภาค 10.xlsx")
            Case "ภาค 11"
                Set twb = Workbooks.Open(fPath & "ภาค 11.xlsx")
        End Select
        For Each file In subFolder.Files
            Set wb = Workbooks.Open(file)
            For Each sh In wb.Worksheets
                For Each scSh In twb.Worksheets
                    If scSh.Name = sh.Name Then
                        scSh.Cells.Copy sh.Range("a1")
                    End If
                Next scSh
            Next sh
            wb.Close False
        Next file
        twb.Close True
    Next subfolder
End Subb
niwat2811
Bronze
Bronze
Posts: 336
Joined: Thu Jan 06, 2011 12:51 pm
Excel Ver: 2016

Re: รวมชีทจากแต่ละไฟล์ที่อยู่ในแต่ละ Subfolder

#6

Post by niwat2811 »

Code สามารถใช้ได้ตรงตามต้องการ ขอบคุณมากครับ
Post Reply