เคล็ดลับในการเพิ่มความเร็วในการคัดลอก / วางภาพ

นี่เป็นโครงการแรกของฉันที่ใช้ VBA ฉันมีรหัส (ดูด้านล่าง) ที่อ่านว่ามีตัวเลขบนแผ่นงานหรือไม่ หากเป็นเช่นนั้นรหัสจะเรียกแมโครเพื่อคัดลอกรูปภาพต้นฉบับจากแผ่นงานอื่นวางลงบนแผ่นงานใหม่และเปลี่ยนชื่อ / เปลี่ยนขนาด / วางกึ่งกลางรูปภาพที่วางในเซลล์

ปัญหาคือฉันสามารถบอกได้ว่ารหัสนี้ทำงานช้า ฉันรู้ว่าใช้ ".select" รหัสช้าลงมาก แต่ฉันไม่รู้ว่ามีวิธีแก้ไขสิ่งที่ฉันต้องทำหรือไม่

นี่คือโค้ดที่ใช้งานได้ (แม้ว่าช้า) ที่ฉันมี (เลื่อนไปด้านล่างสำหรับรูปอ้างอิง)

นี่คือรหัสแรกที่ทดสอบตัวเลขและเรียกมาโคร:

Sub xGridA_Pic_Setup()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Evaluate(WorksheetFunction.CountIf(Worksheets("Rent Grid A").Range("D1:H1"), "1")) < 1 Then
    Else
        Call xGridA_Comp1
            End If
If Evaluate(WorksheetFunction.CountIf(Worksheets("Rent Grid A").Range("D1:H1"), "2")) < 1 Then
    Else
        Call xGridA_Comp2
            End If
If Evaluate(WorksheetFunction.CountIf(Worksheets("Rent Grid A").Range("D1:H1"), "3")) < 1 Then
    Else
        Call xGridA_Comp3
            End If
If Evaluate(WorksheetFunction.CountIf(Worksheets("Rent Grid A").Range("D1:H1"), "4")) < 1 Then
    Else
        Call xGridA_Comp4
            End If
If Evaluate(WorksheetFunction.CountIf(Worksheets("Rent Grid A").Range("D1:H1"), "5")) < 1 Then
    Else
        Call xGridA_Comp5
            End If

If Worksheets("Rent Roll").Range("TOTAL_UNIT_TYPE") > 1 Then
    End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub 

นี่คือส่วนหนึ่งของแมโครที่เรียกว่า:

Sub xGridA_Comp1()

Sheets("Rent Data Entry").Select
ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select
Selection.Copy

Sheets("Rent Grid A").Select
If Range("D1") <> 1 Then
    Else
        Range("RGA_COMP1_CELL").Select
        ActiveSheet.Paste
    With ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select
        Selection.Name = "PIC_RGA_CMP1_1"
        Selection.ShapeRange.Height = 97.2
        Selection.ShapeRange.Width = 129.6
    End With
    With ActiveSheet.Shapes("PIC_RGA_CMP1_1")
        .Top = Range("RGA_COMP1_CELL").Top + (Range("RGA_COMP1_CELL").Height - .Height) / 2
        .Left = Range("RGA_COMP1_CELL").Left + (Range("RGA_COMP1_CELL").Width - .Width) / 2
    End With
End If


If Range("E1") <> 1 Then
    Else
        Range("RGA_COMP2_CELL").Select
        ActiveSheet.Paste
    With ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select
        Selection.Name = "PIC_RGA_CMP1_2"
        Selection.ShapeRange.Height = 97.2
        Selection.ShapeRange.Width = 129.6
    End With
    With ActiveSheet.Shapes("PIC_RGA_CMP1_2")
        .Top = Range("RGA_COMP2_CELL").Top + (Range("RGA_COMP2_CELL").Height - .Height) / 2
        .Left = Range("RGA_COMP2_CELL").Left + (Range("RGA_COMP2_CELL").Width - .Width) / 2
    End With
End If


If Range("F1") <> 1 Then
    Else
        Range("RGA_COMP3_CELL").Select
        ActiveSheet.Paste
    With ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select
        Selection.Name = "PIC_RGA_CMP1_3"
        Selection.ShapeRange.Height = 97.2
        Selection.ShapeRange.Width = 129.6
    End With
    With ActiveSheet.Shapes("PIC_RGA_CMP1_3")
        .Top = Range("RGA_COMP3_CELL").Top + (Range("RGA_COMP3_CELL").Height - .Height) / 2
        .Left = Range("RGA_COMP3_CELL").Left + (Range("RGA_COMP3_CELL").Width - .Width) / 2
    End With
End If


If Range("G1") <> 1 Then
    Else
        Range("RGA_COMP4_CELL").Select
        ActiveSheet.Paste
    With ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select
        Selection.Name = "PIC_RGA_CMP1_4"
        Selection.ShapeRange.Height = 97.2
        Selection.ShapeRange.Width = 129.6
    End With
    With ActiveSheet.Shapes("PIC_RGA_CMP1_4")
        .Top = Range("RGA_COMP4_CELL").Top + (Range("RGA_COMP4_CELL").Height - .Height) / 2
        .Left = Range("RGA_COMP4_CELL").Left + (Range("RGA_COMP4_CELL").Width - .Width) / 2
    End With
End If


If Range("H1") <> 1 Then
    Else
        Range("RGA_COMP5_CELL").Select
        ActiveSheet.Paste
    With ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select
        Selection.Name = "PIC_RGA_CMP1_5"
        Selection.ShapeRange.Height = 97.2
        Selection.ShapeRange.Width = 129.6
    End With
    With ActiveSheet.Shapes("PIC_RGA_CMP1_5")
        .Top = Range("RGA_COMP5_CELL").Top + (Range("RGA_COMP5_CELL").Height - .Height) / 2
        .Left = Range("RGA_COMP5_CELL").Left + (Range("RGA_COMP5_CELL").Width - .Width) / 2
    End With
End If


End Sub

นี่คือสกรีนช็อตของชีตที่วางรูปภาพที่แสดงตำแหน่งที่อ่านตัวเลขจาก:

เคล็ดลับใด ๆ ในการเร่งความเร็วนี้จะได้รับการชื่นชมอย่างมาก! รหัสนี้จะต้องเรียกใช้บนตารางมากถึง 10 ซึ่งเหมือนกับรหัสในรูปภาพ ขอบคุณ!!!