Snasui Excel Forum

Posted: **Fri Jun 14, 2019 9:45 am**

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

ขอปรึกษาเรื่องการใช้ 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

Posted: **Sun Jun 16, 2019 5:59 am**

ตัวอย่าง 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

Posted: **Sun Jun 16, 2019 9:32 pm**

snasui wrote: Sun Jun 16, 2019 5:59 am ตัวอย่าง 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

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

Posted: **Tue Jun 18, 2019 10:08 am**

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

ขอบคุณครับ

Posted: **Fri May 21, 2021 1:25 pm**

snasui wrote: Sun Jun 16, 2019 5:59 am ตัวอย่าง 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

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

Snasui Excel Forum

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

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

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

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

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

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