Application.ScreenUpdating ทำงานช้าผิดปกติ

[yangkodza]

สวัสดีครับรบกวนสอบถามการทำงานของ Application.ScreenUpdating
ทำงานได้ครับ แต่ว่ากว่าจะประมวลผลเสร็จประมาณ 35 วินาที
ตามลักษณะงานได้จัดการรายละเอียดต่างๆไว้หมดแล้ว

แต่ว่า สามารถกดปุ่ม กลับสถานะปกติ (ตัวนี้คือตัวที่อืดครับ)
และเมื่อทำงานเสร็จแล้วจะไปเขียนข้อมูลลงไว้ใน แผ่นงานสถิติ โดยจะเรียงไปทางขวาอัตโนมัติ ครับผม
vba ที่ใช้คือ

Code: Select all

Sub เก็บฐานข้อมูล()
    Dim rngTarget As Range
    Application.ScreenUpdating = False
    Sheets("ใบลงเวลาทำงาน").Select
    Range("I7:I117").Select
    Selection.Copy
    Sheets("สถิติ").Select
    Set rngTarget = Range("a1").End(xlToRight).Offset(0, 1)
    rngTarget.Offset(1, 0).Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Sheets("ไม่ต้องสนใจ").Select
    Range("D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("สถิติ").Select
    rngTarget.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-th-TH,107]d mmm yy;@"
    '************************************
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 90
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
      Selection.ColumnWidth = 3
      '**************************
    rngTarget.EntireColumn.Select
    Selection.Replace What:="ลืมบัตร", Replacement:="ล", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ไม่รูดเข้า/ออก", Replacement:="ม", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ขาด", Replacement:="ข", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลากิจ", Replacement:="ก", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลาป่วย", Replacement:="ป", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ลาคลอด", Replacement:="ค", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="ไปราชการ", Replacement:="ร", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
         Selection.Replace What:="ลาครึ่งวัน", Replacement:="ลคว", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="สาย", Replacement:="ส", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("C1").Select
    Sheets("ใบลงเวลาทำงาน").Select
    Application.ScreenUpdating = True
End Sub

รบกวนช่วยตรวจสอบสาเหตุที่ช้าให้ทีครับ ขอบคุณมากครับ

ประมวลผลช้าผิดปกติ.xlsm

[snasui]

ความช้าน่าจะเกิดจากสูตรคำนวณที่เป็น Matrix เช่น Sumproduct มากกว่าครับ

ควรปรับโปรแกรมให้คำนวณเป็น Manual เสียก่อนเมื่อทำงานเสร็จแล้วค่อยปรับมาเป็นอัตโนมัติ ลักษณะของ Code จะกลายเป็นเช่นด้านล่างครับ

Code: Select all

'Other code
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Other code
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'Other code

[yangkodza]

ความช้าน่าจะเกิดจากสูตรคำนวณที่เป็น Matrix เช่น Sumproduct มากกว่าครับ

ควรปรับโปรแกรมให้คำนวณเป็น Manual เสียก่อนเมื่อทำงานเสร็จแล้วค่อยปรับมาเป็นอัตโนมัติ ลักษณะของ Code จะกลายเป็นเช่นด้านล่างครับ

Code: Select all

'Other code
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Other code
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'Other code

เพิ่ม code 2 บรรทัด ชีวิตเปลี่ยนทันที
ขอบคุณมากครับอาจารย์