vba - 快速复制和粘贴公式

Question

我一直在尝试编写一个简单的代码，从一个单元格中复制值并将其公式粘贴到一列中的所有单元格中(有几个单元格，大约 3000 个)。该代码有效，但运行大约需要 30 分钟，所以对我来说不太合适。我也试过让公式的值不带“=”，然后使用替换命令，但效果不佳。任何人都可以帮助我在 1 分钟内运行宏？这是我尝试执行的代码的一部分:

sub copy_paste

Worksheets("Formatar").Range("H1:L1").Copy
Worksheets("Formatar").Range("H3").PasteSpecial xlValue
Worksheets("Formatar").Range("H3:L3").Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial xlFormulas

end sub

Answer 1

告诉我这是否对你有帮助...

Sub copy_paste()
    Worksheets("Formatar").Range("H1:L1").Copy 'Copy from row 1
    Worksheets("Formatar").Range("H3").PasteSpecial xlPasteValues 'paste the values to row 3
    Worksheets("Formatar").Range("H3:L3").Copy 'here you copy that (the values) 
    Range(Selection, Selection.End(xlDown)).Select 'you select eveything from row3 
    Selection.PasteSpecial xlPasteValues 'and paste it... but you copy just values from 3! 
End Sub

然后您将其粘贴到第一次出现的地方，然后您丢失了数据。

这是我的建议。

Sub copy_paste()
    Dim sht As Worksheet
    Dim r
    Dim H
    Dim L
    
    Set sht = Sheets("Formatar") 'store the sheet
    
    sht.Activate 'activate it!
    Range("H1:L1").Copy
    Range("H3").PasteSpecial xlPasteFormulas 'Paste the formula
    Range("H3:L3").Copy 'then copy again
    
    H = Range("H1").Column 'Just to take the number of the columns H and L
    L = Range("L1").Column
    
    r = Range("H3").End(xlDown).Row - 1 'Take the number of the last blank row.
    Range(Cells(3, H), Cells(r, L)).PasteSpecial xlPasteValues
    'Here you paste values, of if you need the
    'formula use this: xlPasteFormulas
    Application.CutCopyMode = False 'never forget this...
End Sub

编辑

也许这会有所帮助...

'Application.Calculation = xlManual



Sub copy_paste()
    Dim sht As Worksheet
    Dim r
    Dim H
    Dim L
    
    Set sht = Sheets("Formatar") 'store the sheet
    
    sht.Activate 'activate it!
    Range("H1:L1").Copy
    Range("H3").PasteSpecial xlPasteFormulas 'Paste the formula
    Application.Calculation = xlManual 'Not automatic calculation
    Range("H3:L3").Copy 'then copy again
    
    H = Range("H1").Column 'Just to take the number of the columns H and L
    L = Range("L1").Column
    
    r = Range("H3").End(xlDown).Row - 1 'Take the number of the last blank row.
    Range(Cells(3, H), Cells(r, L)).PasteSpecial xlPasteValues
    'Here you paste values, of if you need the
    'formula use this: xlPasteFormulas
    Application.CutCopyMode = False 'never forget this...
    Calculate 'Calculate the whole sheet
    Application.Calculation = xlCalculationAutomatic 'return automatic calculation
End Sub