更快的复制粘贴公式代码

jacksc

test.rar (393.59 KB, 下载次数: 1)

2018-11-21 11:07 上传

点击文件名下载附件

老师：我用下面双循环代码，虽达到目的，但速度太慢，请教更快的代码，谢谢！
Sub 计算()
    Dim i&, j&, r&, c&, rng As Range
    With ActiveSheet
        Application.ScreenUpdating = False            '关闭屏幕闪烁
        .Activate
        r = Sheet5.[b65536].End(3).Row
        .[h12] = "=IF(RIGHT($C$2,4)=""当期数据"",SUMIFS(部门费用明细!$E$7:$E$" & r & ",部门费用明细!$D$7:$D$" & r & ",$F$4,部门费用明细!$F$7:$F$" & r & ",H$6,部门费用明细!$B$7:$B$" & r & ",$B12),IF(RIGHT($C$2,4)=""同期数据"",SUMIFS(部门费用明细!$E$7:$E$" & r & ",部门费用明细!$D$7:$D$" & r & ",$F$2,部门费用明细!$F$7:$F$" & r & ",H$6,部门费用明细!$B$7:$B$" & r & ",$B12),SUMIFS(部门费用明细!$E$7:$E$" & r & ",部门费用明细!$D$7:$D$" & r & ",$F$2,部门费用明细!$F$7:$F$" & r & ",H$6,部门费用明细!$B$7:$B$" & r & ",$B12)-SUMIFS(部门费用明细!$E$7:$E$" & r & ",部门费用明细!$D$7:$D$" & r & ",$F$4,部门费用明细!$F$7:$F$" & r & ",H$6,部门费用明细!$B$7:$B$" & r & ",$B12)))"
        r = .[e65536].End(3).Row
        c = .[iv7].End(1).Column
        For i = 9 To r
            For j = 6 To c
                If .Cells(i, j).Value = "" Then
                    .[h12].Copy
                    .Cells(i, j).PasteSpecial xlPasteFormulas
                End If
            Next
        Next
        If (OpenClipboard(0&)) Then               '清除剪贴板
            Call EmptyClipboard
            Call CloseClipboard
        End If
        
        Application.ScreenUpdating = True            '打开屏幕闪烁
    End With
    MsgBox "计算完毕。", vbInformation, "品质当先，筑就诚信！"
End Sub