चित्रों को कॉपी / पेस्ट करने की गति बढ़ाने के लिए टिप्स?

Question

यह 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 तालिकाओं तक चलाने की आवश्यकता है। धन्यवाद!!!

Comments

1) एक ही वर्कशीट फ़ंक्शन को बार-बार पुन: मूल्यांकन करने के बजाय, इसे एक वैरिएबल पर असाइन करें, फिर Select Caseकई IFएस के बजाय उपयोग करने का प्रयास करें । 2)

— साइबरनेटिक.नोमेड