这是我使用VBA的第一个项目。我有一个代码(见下文),它会读取工作表上是否有数字。如果是,则代码将调用宏来从另一个工作表复制源图片,将其粘贴到新工作表上,并在单元格中重命名/调整大小/居中粘贴的图片。
问题是我已经知道这段代码运行缓慢了。我知道使用“.select”可以减慢代码速度,但我不知道是否有解决方法需要做什么。
这是我的工作(虽然很慢)代码。(滚动到底部以供参考pic)
这是第一个测试数字并调用宏的代码:
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个表中运行,这些表与图片中的表相同。谢谢!!!
Select Case
而不是多个IF
s。2)避免