การRunหลายๆ Macro

[วังวู ช่ง]

เรียนท่าน อาจารย์ และสมาชิกทุกท่านครับ ผมติดปัญหาหน่อยแก้ไม่ตกครับ คือว่า ผมได้นำ Code ของอาจารย์มานำใช้กับหน้าเวียกของผมด้วยกันหลาย Code แต่ในนี้ผมอยากจะกดคั้งเดียวแต่ให้ Run Code ตามลำดับอย่างนี้ครับ (มีวิทีทำได้ หลื ป่าวครับ?)

Code: Select all

Sub Macro1()
    Dim rAll As Range, r As Range
    Dim rSource As Range, i As Integer
    Application.ScreenUpdating = False
    Range("AH1:XFD" & Rows.Count).Clear
    Range("A12:AG12").Insert Shift:=xlDown
    Range("A12:AG12").Select
    Range("A12") = "Col1"
    Range("A12").AutoFill Destination:=Range("A12:AG12"), Type:=xlFillDefault
    Range("G:G").Copy Range("AH:AH")
    Range("AH:AH").UnMerge
    Range("AH:AH").RemoveDuplicates Columns:=1, Header:=xlYes
    Range("AH1:AH13").Insert Shift:=xlDown
    With ActiveSheet
        Set rAll = .Range("AH18", .Range("AH" & Rows.Count).End(xlUp))
        Set rSource = .Range("A12", .Range("A" & Rows.Count).End(xlUp)).Resize(, 33)
     End With
    For Each r In rAll
        Range("AH12").Formula = "=G13=" & r
        With ActiveSheet
            rSource.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
            .Range("AH11:AH12"), CopyToRange:=.Range("AI11").Offset(0, i)
            .Range("AI1").Offset(0, i).Resize(11, 33) = .Range("A1:AG11").Value
            i = i + 34
        End With
    Next r
    Range("AH:AH").Clear
    Range("A12:AG12").Delete Shift:=xlUp
       Range("A1:AG1").Select
        Application.ScreenUpdating = True
End Sub

Code: Select all

Sub FormatTable()
Application.ScreenUpdating = False
   Range("AD7:AG7").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(R[5]C[-23],name,2,0)"
    Dim i As Integer, j As Integer
    j = Sheets("List").UsedRange.Columns.Count
    Range("A1:AG11").Copy
    For i = 35 To j Step 34
            Sheets("List").Cells(1, i).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteFormats
    Next i
    Application.CutCopyMode = False
    Range("AD7:AG7").Select
    ActiveCell.FormulaR1C1 = "=name!R[-6]C[-29]"
    Range("A1:AG1").Select
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub SubSelectTable()
    Dim i As Integer, j As Integer, r As Range
    Set r = Sheets("List").Range("A1")
    With Sheets("List")
        j = .UsedRange.Columns.Count
        For i = 1 To j Step 34
            Set r = Union(r, Range(.Cells(1, i).CurrentRegion.Resize(.Cells(1, i) _
                .CurrentRegion.Rows.Count + 10).Address))
        Next i
        r.Select
     End With
End Sub

[snasui]

สามารถสร้างมาอีก Sub เพื่อใช้ Run Code ครับ ยกตัวอย่างเช่นด้านล่าง หรือจะ Call Sub อื่น ๆ ใน Sub Procedure ตัวแรกก็ได้ครับ

Code: Select all

Sub RunAllCode()
   Call Macro1
   Call FormatTable
   Call SubSelectTable
End Sub

[วังวู ช่ง]

สามารถสร้างมาอีก Sub เพื่อใช้ Run Code ครับ ยกตัวอย่างเช่นด้านล่าง หรือจะ Call Sub อื่น ๆ ใน Sub Procedure ตัวแรกก็ได้ครับ

Code: Select all

Sub RunAllCode()
   Call Macro1
   Call FormatTable
   Call SubSelectTable
End Sub

ได้แล้วครับ ท่าน อาจารย์ ครับ ขอบคุณท่านมากๆครับ

[sosadboy]

ขอขอบคุณด้วยเช่นกันครับ กำลังหาอยู่เลยครับ

[Chanisa]

เรียน สอบถามค่ะ หากต้องการ run หลายๆ Modules ต้องใช้ code อะไรคะ

[snasui]

ใช้ Code ตามที่ตอบไว้ในโพสต์ #2 ได้เลย ลองนำไปประยุกต์ดูก่อน ติดแล้วค่อยนำมาถามกันต่อครับ

[Chanisa]

เรียน อาจารย์ และทุกท่านค่ะ
เนื่องจาก มีเขียน VBA ไว้ 2 Modules ตามเอก excel ที่แนบ คือ AUS7470& SCGSM2530

ทั้งนี้ ได้ลองใช้ " Run all Code " โดย copy code ทั้งสอง 2 Modules ไว้ที่ Runall(exportSAP)
แต่ run แล้วติด "debug 400 "

รบกวนสอบถาม
หากต้องการ run ตาม Modules ที่เขียนไว้ ต่อเนื่องกัน ต้องใช้ code ไหน บ้างค่ะ


ขอบคุณล่วงหน้าค่ะ


Chanisa

[snasui]

เรียก Procedure ตามด้านล่างนี้ครับ

Code: Select all

CreateFolder7470()
CreateFolder2530()

แต่ละ Procedure จะไปเรียก Procedure ที่เกี่ยวข้องเองครับ