บันทึกแมโคร สามารถกระชับโค้ดได้อีกมั้ยค่ะ

[fonzaaaa1010]

Code: Select all

Sub à¤ÅÕÂÃì()
    Range("A18:E36,D3:D17").Select
    Selection.ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A18:E36").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -4165632
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -4165632
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = -4165632
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Color = -4165632
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Color = -4165632
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

ค่าใช้จ่าย.xlsm

ฝนไม่ค่อยรู้เกี่ยวกับโค้ด VBA เท่าไรค่ะ
เลยศึกษาเรื่องการบันทึกแมโคร
แล้วเอาโค้ดมาใส่ต่อๆกัน
อยากทราบว่าโค้ดด้านบนนี้สามารถกระชับโค้ดได้อีกมั้ยค่ะ
พอเวลาเรียกใช้แล้วมันกระพริบหลายทีค่ะ

[au_montree]

แก้ปัญหาเมื่อรันคำสั่งแล้วจอกระพริบหลายครั้ง
Application.ScreenUpdating = False (ใส่คำสั่งนี้ใต้คำสั่ง Sub เคลียร์)

Application.ScreenUpdating = True (ใส่คำสั่งนี้เหนือคำสั่ง End Sub)

[snasui]

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

Code: Select all

Sub เคลียร์()
    Range("A18:E36,D3:D17").Select
    Selection.ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A18:E36").Select
    With Selection
        .VerticalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .Borders.Color = -4165632
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeTop).Color = -4165632
    End With
End Sub