Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://www.snasui.com/

การแยกข้อมูลออกจากฐานป็นเดือน

https://www.snasui.com/viewtopic.php?t=1650

Page 1 of 2

การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Mon Oct 03, 2011 1:25 pm
by yodpao.b

Code: Select all

Sub MacroAdvancedFilter()   'code นี้อยู่ในโมดูล 8
    Workbooks.Add
    Range("A5").Select  'กรองข้อมุล
    Workbooks("OT_New.xls").Sheets("ฐานข้อมูลล่วงเวลา").Range("A6:AC65536"). _
        AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Workbooks("OT_New.xls") _
        .Sheets("ฐานข้อมูลล่วงเวลา").Range("X2:X3"), CopyToRange:=Range("A5"), _
        Unique:=False

    Windows("OT_New.xls").Activate      'copy
    Rows("4:6").Select
    Selection.Copy
    Application.WindowState = xlMinimized
    [color=#BF4080]Windows("Book6").Activate[/color]
    Range("A3").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
End Sub
อาจาร์ยครับ Code ด้านบน ผมใช้แมโครทำขึ้นมา คือการกรองข้อมูลขั้นสูงแล้วนำมาไว้ใน Workbooks ใหม่
ต่อจากนั้นเป็นการ Copy จาก Workbooks("OT_New.xls").Sheets("ฐานข้อมูลล่วงเวลา") บรรทัดที่ 4-6
มาไว้ใน สมุดงานใหม่
แต่โปรแกรม eeror ตรงที่ Code "Windows("Book6").Activate"
สาเหตุคงจะเป็นตรงชื่อสมุดงานครับ จะแก้ไขอย่างไรดี
(เชลที่ใช้เลือกเดือนอยู่ที่ x2 , x3) ในSheets("ฐานข้อมูลล่วงเวลา")

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Mon Oct 03, 2011 2:42 pm
by snasui
yodpao.b wrote:แต่โปรแกรม eeror ตรงที่ Code "Windows("Book6").Activate"
สาเหตุคงจะเป็นตรงชื่อสมุดงานครับ จะแก้ไขอย่างไรดี
:D ลองเปลี่ยนเป็น Windows("Book6.xls").Activate หรือ Windows("Book6.xlsx").Activate (ขึ้นอยู่กับว่าใช้ Excel Version ใด) ดูครับ

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Mon Oct 03, 2011 4:04 pm
by yodpao.b
เหมือนเดิมครับอาจาร์ย มันออกมาเฉพาะข้อมูล หัวข้อไม่ออก
เข้าใจว่าชื่อ book มันเปลี่ยนไปเรื่อย มันน่าจะใช้ลัษณะนามว่า
bookที่คุณใช้งานก่อนหน้านี้ ให้ทำการ copy
ขอบคุณครับ พรุ่งนี้พบกันใหม่

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Tue Oct 04, 2011 1:28 pm
by snasui
:D ลองดู Code ด้านล่างครับว่าทำงานได้หรือไม่

Code: Select all

Sub MacroAdvancedFilter()
    Set Newbook = Workbooks.Add
    Workbooks("OT_New.xls").Activate
    Sheets("ฐานข้อมูลล่วงเวลา").Range("A5").Select    '   การกรองข้อมูล
    Workbooks("OT_New.xls").Sheets("ฐานข้อมูลล่วงเวลา").Range("A6:AC65536"). _
        AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Workbooks("OT_New.xls") _
        .Sheets("ฐานข้อมูลล่วงเวลา").Range("X2:X3"), CopyToRange:=Range("A5"), _
        Unique:=False        
    Windows("OT_New.xls").Activate   '   การ copy
    Rows("4:6").Select
    Selection.Copy
    Application.WindowState = xlMinimized
    Newbook.Activate
    Range("A3").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
End Sub

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Wed Oct 05, 2011 11:21 am
by yodpao.b
เรียบร้อยแล้วครับอาจาร์ย
ต้องเอาบรรทัดนี้ออกด้วยครับถึงไม่ Error
"Workbooks("OT_New.xls").Activate"
เคยได้ยินอาจาร์ยเขียนว่า ให้ลอง รันที่ละสเตป หมายถึง สามารถสั่งให้รันที่ละบบรทัดได้หรือครับ

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Wed Oct 05, 2011 12:44 pm
by snasui
yodpao.b wrote:เคยได้ยินอาจาร์ยเขียนว่า ให้ลอง รันที่ละสเตป หมายถึง สามารถสั่งให้รันที่ละบบรทัดได้หรือครับ
:D ยินดีด้วยครับ สำหรับการ Run ทีละ Step ให้กดแป้น F8 ซ้ำ ๆ แล้วดูผลครับ จะติดตามได้ว่าติดที่บรรทัดใด จะได้แก้ได้ตรงจุดครับ :P

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Wed Oct 05, 2011 12:49 pm
by yodpao.b
ขอบคุณครับ

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Wed Oct 12, 2011 12:57 pm
by yodpao.b

Code: Select all

Sub MacroAdvancedFilter()
On Error Resume Next

    Set Newbook = Workbooks.Add
    Range("A5").Select  '¡Ãͧ¢éÍÁØÅ
    Workbooks("OT_New.xls").Sheets("°Ò¹¢éÍÁÙÅÅèǧàÇÅÒ").Range("A6:AC65536"). _
        AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Workbooks("OT_New.xls") _
        .Sheets("°Ò¹¢éÍÁÙÅÅèǧàÇÅÒ").Range("X2:X3"), CopyToRange:=Range("A5"), _
        Unique:=False
                
    If Range("A6") <> "" Then
                Windows("OT_New.xls").Activate   '   ¡ÒÃ copy
                Sheets("°Ò¹¢éÍÁÙÅÅèǧàÇÅÒ").Select
                Rows("4:6").Select
                Selection.Copy
                Application.WindowState = xlMinimized
                Newbook.Activate
                Range("A3").Select
                ActiveSheet.Paste
                Range("A1").Select
                Application.CutCopyMode = False
                
    Columns("A:AC").Select   '   ¨Ñ´¤ÇÒÁ¡ÇéÒ§àªÅ
    Columns("A:AC").EntireColumn.AutoFit
    Columns("C:C").ColumnWidth = 18.86
    Columns("F:F").ColumnWidth = 14.57
    Columns("G:G").ColumnWidth = 11.86
    Columns("H:H").ColumnWidth = 17
    Columns("I:I").ColumnWidth = 18
    Range("A1").Select
                
                                    MsgBox "·èÒ¹·Ó¡Òà Export File à´×͹  " & Range("X6") & "  àÃÕºÂÃéÍÂáÅéÇ ¡ÃØ³Ò Save File ´éÇÂ", vbExclamation, "Export File"
                                    'ActiveWorkbook.SaveAs
                                    ActiveWindow.Close
                            
            Else
                MsgBox "à´×͹·Õè·èÒ¹àÅ×Í¡äÁèÁÕã¹°Ò¹¢éÍÁÙÅ", vbExclamation, "Export File"
                ActiveWindow.Close
            End If
            
End Sub

Code: Select all

            Else
                MsgBox "à´×͹·Õè·èÒ¹àÅ×Í¡äÁèÁÕã¹°Ò¹¢éÍÁÙÅ", vbExclamation, "Export File"
                ActiveWindow.Close
            End If
เมื่อ สั่ง ปิด New Book เครื่องจะถามว่าต้องการ Save ไหม
เป็นไปได้ไหมครับ ให้ไฟล์ปิดไปเลยโดยไม่ต้องถามอะไรและไม่ Save ด้วย (สิ่งที่เครื่องถามอยู่ในรูปด้านล่าง)
Untitled.gif

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Wed Oct 12, 2011 12:59 pm
by snasui
yodpao.b wrote:เมื่อ สั่ง ปิด New Book เครื่องจะถามว่าต้องการ Save ไหม
เป็นไปได้ไหมครับ ให้ไฟล์ปิดไปเลยโดยไม่ต้องถามอะไร
:D :tt: เป็นไปได้ครับ สามารถใช้ Code ตามด้านล่างครับ

Code: Select all

ActiveWindow.Close False

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Wed Oct 12, 2011 1:10 pm
by yodpao.b

Code: Select all

  MsgBox "·èÒ¹·Ó¡Òà Export File à´×͹  " & Range("X6") & "  àÃÕºÂÃéÍÂáÅéÇ ¡ÃØ³Ò Save File ´éÇÂ", vbExclamation, "Export File"
                                    ActiveWorkbook.SaveAs
                                    'ActiveWindow.Close
อาจาร์ยครับแล้วในกรณีที่ต้องการ Save และให้แสดงถึงขั้นตอนการ Save ครับ
รองใช้ Save As แล้ว มัน Save โดยไม่ถามอะไรเลย

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Wed Oct 12, 2011 1:21 pm
by snasui
yodpao.b wrote:อาจาร์ยครับแล้วในกรณีที่ต้องการ Save และให้แสดงถึงขั้นตอนการ Save ครับ
:D ลองตามด้านล่างครับ

Code: Select all

'Other code
fileSaveName = Application.GetSaveAsFilename( _
    fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName <> False Then
    MsgBox "Save as " & fileSaveName
End If 
'Other code

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Fri Oct 14, 2011 1:34 pm
by yodpao.b
เรียนอาจารย์ครับอยากให้อาจาร์ยช่วย Run Code นี้หน่อยครับ ไม่เข้าใจว่าทำไม่ excle ถึงอยู่เมนูบาร์ด้านล่าง มันไม่ยอมทำงานให้จบขั้นตอนครับ
Untitled3.gif

Code: Select all

Sub MacroAdvancedFilter()
On Error Resume Next

    Set Newbook = Workbooks.Add
    Range("A5").Select  '¡Ãͧ¢éÍÁØÅ
    Workbooks("OT_New.xls").Sheets("°Ò¹¢éÍÁÙÅÅèǧàÇÅÒ").Range("A6:AC65536"). _
        AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Workbooks("OT_New.xls") _
        .Sheets("°Ò¹¢éÍÁÙÅÅèǧàÇÅÒ").Range("X2:X3"), CopyToRange:=Range("A5"), _
        Unique:=False
                
    If Range("A6") <> "" Then
                                                            
                Windows("OT_New.xls").Activate   '   ¡ÒÃ copy
                Sheets("°Ò¹¢éÍÁÙÅÅèǧàÇÅÒ").Select
                Rows("4:6").Select
                Selection.Copy
                Application.WindowState = xlMinimized
                Newbook.Activate
                Range("A3").Select
                ActiveSheet.Paste
                Range("A1").Select
                Application.CutCopyMode = False
                
    Columns("A:AC").Select   '   ¨Ñ´¤ÇÒÁ¡ÇéÒ§àªÅ
    Columns("A:AC").EntireColumn.AutoFit
    Columns("C:C").ColumnWidth = 18.86
    Columns("F:F").ColumnWidth = 14.57
    Columns("G:G").ColumnWidth = 11.86
    Columns("H:H").ColumnWidth = 17
    Columns("I:I").ColumnWidth = 18
    Range("A1").Select
    
                                          MsgBox "·èÒ¹·Ó¡Òà Export File à´×͹  " & Range("X6") & "  àÃÕºÂÃéÍÂáÅéÇ ¡ÃØ³Ò Save File ´éÇÂ", vbExclamation, "Export File"
                                         ActiveWindow.Close
                            
            Else
                MsgBox "à´×͹·Õè·èÒ¹àÅ×Í¡äÁèÁÕã¹°Ò¹¢éÍÁÙÅ", vbExclamation, "Export File"
                ActiveWindow.Close False
            End If
End Sub
ทั้งนี้ผมได้แนบไฟล์และวิธี RUn from6
Untitled1.gif
Untitled2.gif
Untitled3.gif

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Fri Oct 14, 2011 1:36 pm
by yodpao.b
แนบไฟล์

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Fri Oct 14, 2011 1:43 pm
by snasui
:lol: ก่อนที่จะถามในประเด็นต่อไป ควรจะตอบด้วยครับว่าที่ผมตอบไปคราวก่อนนั้นได้ผลหรือไม่อย่างไร หากไม่ได้ผลได้ใช้การแก้ไขด้วยวิธีใดไปแล้วหรือไม่

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Fri Oct 14, 2011 2:47 pm
by yodpao.b
Sub Macro1()
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName <> False Then
MsgBox "Save as " & fileSaveName
End If
End Sub
จากหัวข้อที่แล้ว โคด้ที่อาจาร์ยให้มา ตรงตามที่ต้องการครับแต่ว่าเมื่อทดสอบดูมันไม่ Save ลง เครื่อง
ผมเลยใช้ โดดด้านล่างนี้ไปก่อน ได้ผลคล้ายกันแต่มันไม่แสดง MsgBox เท่านั้นเอง กะว่าจะลองไปทดสอบใหม่ในวันหยุด
ถ้าอาจาร์ยมีเวลารบกวนช่วยตอบคำถามข้อถัดมาด้วยครับ

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Fri Oct 14, 2011 2:49 pm
by yodpao.b
yodpao.b wrote:Sub Macro1()
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName <> False Then
MsgBox "Save as " & fileSaveName
End If
End Sub
จากหัวข้อที่แล้ว โคด้ที่อาจาร์ยให้มา ตรงตามที่ต้องการครับแต่ว่าเมื่อทดสอบดูมันไม่ Save ลง เครื่อง
ผมเลยใช้ โดดด้านล่างนี้ไปก่อน ได้ผลคล้ายกันแต่มันไม่แสดง MsgBox เท่านั้นเอง กะว่าจะลองไปทดสอบใหม่ในวันหยุด
ถ้าอาจาร์ยมีเวลารบกวนช่วยตอบคำถามข้อถัดมาด้วยครับ

Code: Select all

ActiveWindow.Close

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Fri Oct 14, 2011 3:03 pm
by snasui
yodpao.b wrote:Sub Macro1()
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName <> False Then
MsgBox "Save as " & fileSaveName
End If
End Sub
จากหัวข้อที่แล้ว โคด้ที่อาจาร์ยให้มา ตรงตามที่ต้องการครับแต่ว่าเมื่อทดสอบดูมันไม่ Save ลง เครื่อง
...
:D ลองทดสอบ Code ด้านล่างครับว่า Save ในตำแหน่งที่เลือกหรือไม่

Code: Select all

Sub Macro1()
Dim fileSaveName As String
fileSaveName = Application.GetSaveAsFilename( _
    fileFilter:="Excel Files (*.xls), *.xls")
ActiveWorkbook.SaveAs Filename:=fileSaveName
If fileSaveName <> "False" Then
    MsgBox "Save as " & fileSaveName
End If
End Sub

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Fri Oct 14, 2011 3:30 pm
by yodpao.b
Save แล้วครับอาจาร์ย ขอบคุณมากครับ อาจารย์ขอข้อถัดไปด้วยครับ

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Fri Oct 14, 2011 6:17 pm
by snasui
:D จากคำถามที่ว่าไม่จบขั้นตอน ช่วยลำดับมาให้ด้วยครับว่า ทำอะไร อย่างไร การจบขั้นตอนที่ว่านั้นผลลัพธ์ควรเป็นอย่างไร :?:

Re: การแยกข้อมูลออกจากฐานป็นเดือน

Posted: Mon Oct 17, 2011 11:57 am
by yodpao.b

Code: Select all

Sub MacroAdvancedFilter()
On Error Resume Next

    Set Newbook = Workbooks.Add
    Range("A5").Select  '¡Ãͧ¢éÍÁØÅ
    Workbooks("Overtime.xls").Sheets("°Ò¹¢éÍÁÙÅÅèǧàÇÅÒ").Range("A6:AC65536"). _
        AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Workbooks("Overtime.xls") _
        .Sheets("°Ò¹¢éÍÁÙÅÅèǧàÇÅÒ").Range("X2:X3"), CopyToRange:=Range("A5"), _
        Unique:=False
                
    If Range("A6") <> "" Then
                                                            
                Windows("Overtime.xls").Activate   '   ¡ÒÃ copy
                Sheets("°Ò¹¢éÍÁÙÅÅèǧàÇÅÒ").Select
                Rows("4:6").Select
                Selection.Copy
                Application.WindowState = xlMinimized
                Newbook.Activate
                Range("A3").Select
                ActiveSheet.Paste
                Range("A1").Select
                Application.CutCopyMode = False
                
    Columns("A:AC").Select   '   ¨Ñ´¤ÇÒÁ¡ÇéÒ§àªÅ
    Columns("A:AC").EntireColumn.AutoFit
    Columns("C:C").ColumnWidth = 18.86
    Columns("F:F").ColumnWidth = 14.57
    Columns("G:G").ColumnWidth = 11.86
    Columns("H:H").ColumnWidth = 17
    Columns("I:I").ColumnWidth = 18
    Range("A1").Select     
                                          MsgBox "·èÒ¹·Ó¡Òà Export File à´×͹  " & Range("X6") & "   àÃÕºÂÃéÍÂáÅéÇ ¡ÃØ³Ò Save File ´éÇÂ", vbExclamation, "Export File"
                                         Call MacroSaveAs
                            
            Else
                MsgBox "à´×͹·Õè·èÒ¹àÅ×Í¡äÁèÁÕã¹°Ò¹¢éÍÁÙÅ", vbExclamation, "Export File"
                ActiveWindow.Close False
            End If
End Sub
หลังจากการ Run Code นี้ ในช่วงขณะที่ Run ไฟล์ excel ได้ลงไปอยุ่นะตำแหน่ง ทาร์บารด้านล่างดังรูปด่านล่าง
ต้องลาก Mouse ไปคลิก Excel ในทาร์บาร จ฿งจะทำการ Run ต่อได้
Untitled3.gif
All times are UTC+07:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited