使由不同位置的按钮触发的复制粘贴代码更快
Make copy-paste code, triggered by button at different locations, faster
我为我们的项目经理制作了一个模型,以跟踪不同项目中的经济情况。
模型的一个愿望是可以选择将行添加到我制作的矩阵中,而不会丢失方案中的公式和小计。
通过从该站点复制粘贴和编辑公式,我在整个矩阵中制作了按钮以添加行。
速度很慢。每当他们按下我的一个按钮时,大约需要 44 秒才能添加新行并将公式等复制粘贴到新行中。
看来问题出在所有的复制粘贴步骤上。
我可以让这个复制粘贴代码更快吗?
我尝试改为复制范围,但我无法做到这一点,既没有复制整行(它也粘贴了按钮,我不希望这样做)。
Sub Tilføj_række()
Dim b As Object, cs As Integer
Set b = ActiveSheet.Shapes(Application.Caller)
With b.TopLeftCell.EntireRow.Offset(1, 0)
.Insert
.Cells(1, 3).Copy .Cells(0, 3)
.Cells(1, 4).Copy .Cells(0, 4)
.Cells(1, 5).Copy .Cells(0, 5)
.Cells(1, 6).Copy .Cells(0, 6)
.Cells(1, 7).Copy .Cells(0, 7)
.Cells(1, 8).Copy .Cells(0, 8)
.Cells(1, 9).Copy .Cells(0, 9)
.Cells(1, 10).Copy .Cells(0, 10)
.Cells(1, 11).Copy .Cells(0, 11)
.Cells(1, 12).Copy .Cells(0, 12)
.Cells(1, 13).Copy .Cells(0, 13)
.Cells(1, 14).Copy .Cells(0, 14)
.Cells(1, 15).Copy .Cells(0, 15)
.Cells(1, 16).Copy .Cells(0, 16)
.Cells(1, 17).Copy .Cells(0, 17)
.Cells(1, 18).Copy .Cells(0, 18)
.Cells(1, 19).Copy .Cells(0, 19)
.Cells(1, 20).Copy .Cells(0, 20)
.Cells(1, 21).Copy .Cells(0, 21)
.Cells(1, 22).Copy .Cells(0, 22)
End With
End Sub
我的矩阵的一部分看起来像这样,其中绿色按钮是代码的触发器。
粗体行包含求和函数。
希望各位大侠能再帮帮我
有时候答案就在你面前简单明了,你却忽略了它....
几乎就在我放弃并发布这个之后,我自己找到了答案,所以如果有人遇到和我一样的麻烦,答案是:
Sub Tilføj_række()
Dim b As Object, cs As Integer
Set b = ActiveSheet.Shapes(Application.Caller)
With b.TopLeftCell.EntireRow.Offset(1, 0)
.EntireRow.Copy
.Insert
End With
End Sub
我为我们的项目经理制作了一个模型,以跟踪不同项目中的经济情况。
模型的一个愿望是可以选择将行添加到我制作的矩阵中,而不会丢失方案中的公式和小计。
通过从该站点复制粘贴和编辑公式,我在整个矩阵中制作了按钮以添加行。
速度很慢。每当他们按下我的一个按钮时,大约需要 44 秒才能添加新行并将公式等复制粘贴到新行中。
看来问题出在所有的复制粘贴步骤上。
我可以让这个复制粘贴代码更快吗?
我尝试改为复制范围,但我无法做到这一点,既没有复制整行(它也粘贴了按钮,我不希望这样做)。
Sub Tilføj_række()
Dim b As Object, cs As Integer
Set b = ActiveSheet.Shapes(Application.Caller)
With b.TopLeftCell.EntireRow.Offset(1, 0)
.Insert
.Cells(1, 3).Copy .Cells(0, 3)
.Cells(1, 4).Copy .Cells(0, 4)
.Cells(1, 5).Copy .Cells(0, 5)
.Cells(1, 6).Copy .Cells(0, 6)
.Cells(1, 7).Copy .Cells(0, 7)
.Cells(1, 8).Copy .Cells(0, 8)
.Cells(1, 9).Copy .Cells(0, 9)
.Cells(1, 10).Copy .Cells(0, 10)
.Cells(1, 11).Copy .Cells(0, 11)
.Cells(1, 12).Copy .Cells(0, 12)
.Cells(1, 13).Copy .Cells(0, 13)
.Cells(1, 14).Copy .Cells(0, 14)
.Cells(1, 15).Copy .Cells(0, 15)
.Cells(1, 16).Copy .Cells(0, 16)
.Cells(1, 17).Copy .Cells(0, 17)
.Cells(1, 18).Copy .Cells(0, 18)
.Cells(1, 19).Copy .Cells(0, 19)
.Cells(1, 20).Copy .Cells(0, 20)
.Cells(1, 21).Copy .Cells(0, 21)
.Cells(1, 22).Copy .Cells(0, 22)
End With
End Sub
我的矩阵的一部分看起来像这样,其中绿色按钮是代码的触发器。
粗体行包含求和函数。
希望各位大侠能再帮帮我
有时候答案就在你面前简单明了,你却忽略了它....
几乎就在我放弃并发布这个之后,我自己找到了答案,所以如果有人遇到和我一样的麻烦,答案是:
Sub Tilføj_række()
Dim b As Object, cs As Integer
Set b = ActiveSheet.Shapes(Application.Caller)
With b.TopLeftCell.EntireRow.Offset(1, 0)
.EntireRow.Copy
.Insert
End With
End Sub