VBA จัดการไฟล์ข้อมูล

[Supachok]

เรียน ท่านผู้รู้

ขอปรึกษาเรื่องการใช้ VBA (copy marco มา)

file sum-dec เป็นข้อมูลว่างๆ ที่ต้องการดึงข้อมูลจาก file อื่นๆระบุวันที่ 6,7,10 Dec
การทำงานคือ

1.copy ช่วงข้อมูล row 1:40 แต่ละไฟล์การรวมใน 1 ไฟล์แยกsheet ตามวัน

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'

'
    Windows("Actual Plant 6-12-2018..xlsx").Activate
    Rows("1:39").Select
    Selection.Copy
    Windows("Sum-dec 18.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("Actual Plant 7-12-2018..xlsx").Activate
    Rows("1:1").Select
    ActiveWindow.SmallScroll Down:=15
    Rows("1:39").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Sum-dec 18.xlsx").Activate
    Sheets("Sheet2").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Windows("Actual Plant 10-12-2018.xlsx").Activate
    Rows("1:1").Select
    ActiveWindow.SmallScroll Down:=12
    Rows("1:39").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Sum-dec 18.xlsx").Activate
    Sheets("Sheet3").Select
    ActiveWindow.SmallScroll Down:=-9
    Rows("1:1").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=12
    Sheets("Sheet1").Select
    ActiveWindow.SmallScroll Down:=-3
    Range("H40").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "6w"
    Range("H41").Select
    ActiveCell.FormulaR1C1 = "10w"
    Range("H40").Select
    Sheets("Sheet2").Select
    ActiveWindow.SmallScroll Down:=15
    Range("H40").Select
    ActiveCell.FormulaR1C1 = "6w"
    Range("H41").Select
    ActiveCell.FormulaR1C1 = "10"
    Range("H41").Select
    ActiveCell.FormulaR1C1 = "w10"
    Range("H41").Select
    ActiveCell.FormulaR1C1 = "10w"
    Range("H42").Select
    Sheets("Sheet3").Select
    Range("H40").Select
    ActiveWindow.SmallScroll Down:=-9
    ActiveCell.FormulaR1C1 = "6w"
    Range("H41").Select
    ActiveCell.FormulaR1C1 = "10"
    Range("H41").Select
    ActiveCell.FormulaR1C1 = "10w"
    Range("H42").Select
End Sub

[snasui]

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

Code นี้ไม่จำเป็นต้องเปิดไฟล์ต้นทางเอาไว้ก่อน เมื่อ Run Code โปรแกรมจะให้เลือกไฟล์ที่ต้องการจะนำมารวมกัน และจะปิดไฟล์ต้นทางไปหลังจากนำมาใช้งานแล้ว

Code: Select all

Sub CollectDataFromMultipleFiles()
    Dim wb As Workbook, s As Worksheet, db As Workbook
    Dim strPath As Variant, i As Integer, f As Byte
    Dim sh As Worksheet
    strPath = Application.GetOpenFilename( _
        FileFilter:="Excel File (*.xls*),*.xls*", _
        MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
    
    Set db = ThisWorkbook

    Application.ScreenUpdating = False
    For i = 1 To UBound(strPath)
        Set wb = Workbooks.Open(Filename:=strPath(i), UpdateLinks:=False)
        With db
            .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
            Set sh = .Worksheets(.Worksheets.Count)
            sh.Name = wb.Name
            wb.Sheets(1).UsedRange.Copy sh.Range("a1")
        End With
        wb.Close , False
        Application.CutCopyMode = False
    Next i
    Application.ScreenUpdating = True
    MsgBox "Finished", vbInformation
End Sub

[Supachok]

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

Code นี้ไม่จำเป็นต้องเปิดไฟล์ต้นทางเอาไว้ก่อน เมื่อ Run Code โปรแกรมจะให้เลือกไฟล์ที่ต้องการจะนำมารวมกัน และจะปิดไฟล์ต้นทางไปหลังจากนำมาใช้งานแล้ว

Code: Select all

Sub CollectDataFromMultipleFiles()
    Dim wb As Workbook, s As Worksheet, db As Workbook
    Dim strPath As Variant, i As Integer, f As Byte
    Dim sh As Worksheet
    strPath = Application.GetOpenFilename( _
        FileFilter:="Excel File (*.xls*),*.xls*", _
        MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
    
    Set db = ThisWorkbook

    Application.ScreenUpdating = False
    For i = 1 To UBound(strPath)
        Set wb = Workbooks.Open(Filename:=strPath(i), UpdateLinks:=False)
        With db
            .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
            Set sh = .Worksheets(.Worksheets.Count)
            sh.Name = wb.Name
            wb.Sheets(1).UsedRange.Copy sh.Range("a1")
        End With
        wb.Close , False
        Application.CutCopyMode = False
    Next i
    Application.ScreenUpdating = True
    MsgBox "Finished", vbInformation
End Sub

จะลองดูครับ
ขอบคุณมากเลย

[Supachok]

เรียน ท่านอาจารย์
Code ที่ให้มาสามารถลดเวลาเปิด - ปิดไฟล์ ได้อย่างมีประสิทธิภาพ
เป็น ร้อยๆไฟล์เลย

ขอบคุณครับ

[suka]

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

Code นี้ไม่จำเป็นต้องเปิดไฟล์ต้นทางเอาไว้ก่อน เมื่อ Run Code โปรแกรมจะให้เลือกไฟล์ที่ต้องการจะนำมารวมกัน และจะปิดไฟล์ต้นทางไปหลังจากนำมาใช้งานแล้ว

Code: Select all

Sub CollectDataFromMultipleFiles()
    Dim wb As Workbook, s As Worksheet, db As Workbook
    Dim strPath As Variant, i As Integer, f As Byte
    Dim sh As Worksheet
    strPath = Application.GetOpenFilename( _
        FileFilter:="Excel File (*.xls*),*.xls*", _
        MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
    
    Set db = ThisWorkbook

    Application.ScreenUpdating = False
    For i = 1 To UBound(strPath)
        Set wb = Workbooks.Open(Filename:=strPath(i), UpdateLinks:=False)
        With db
            .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
            Set sh = .Worksheets(.Worksheets.Count)
            sh.Name = wb.Name
            wb.Sheets(1).UsedRange.Copy sh.Range("a1")
        End With
        wb.Close , False
        Application.CutCopyMode = False
    Next i
    Application.ScreenUpdating = True
    MsgBox "Finished", vbInformation
End Sub

ได้โค้ดนี้ของอาจารย์ช่วยได้มากเลยค่ะ ขอบพระคุณมาก ๆ ค่ะ