使用 VBA 将 Excel 公式写入单元格

Question

就像我的标题中已经写的一样，我试图覆盖错误的 excel 公式。 但它并没有真正起作用。 我将单元格中的公式复制到代码中并放置了一些双引号以使其工作。 已经读过，我必须输入两次“才能在公式中输入一个”。 由于公司合规性，我不知道到底发生了什么，但代码应该这样做。

想象一下，单元格中有 180 个组件具有相同的 18 个 function。 通过删除一些组件，我丢失了参考，而不是再次编写每个公式，我尝试使用 vba 来执行此操作。 希望您能够帮助我。

Sub nachtrag()

Dim i As Integer
Dim j As Integer
Dim Start As Integer
    Start = 4
Dim Bezug As Integer

For i = 0 To 179
    Bezug = Worksheets("QK-Daten").Range("R" & ((i * 18) + 18) + Start).Value
    For j = 1 To 17
    Worksheets("QK-Daten").Range("Z" & j + (i * 18) + Start).Value = "=WENN(R" & Bezug & "="""";"""";SVERWEIS(R" & Bezug & ";'QK-Tabelle'!$B$3:$C$123;2;FALSCH))*(R" & j + (i * 18) + Start & "/R" & Bezug & ")+((N" & j + (i * 18) + Start & "+O" & j + (i * 18) + Start & ")*0,3+(P" & j + (i * 18) + Start & "+Q" & j + (i * 18) + Start & ")*0,1)"
    Next j
    Worksheets("QK-Daten").Range("z" & ((i * 18) + 18) + Start).Copy
    Worksheets("QK-Daten").Range("z" & ((i * 18) + 18) + Start).PasteSpecial Paste:=xlValues
Next i

End Sub

Answer 1

尝试在字符串中使用占位符编写公式，然后使用Replace()替换值。

Option Explicit

Sub nachtrag()

    Dim ws As Worksheet, cell As Range, s As String
    Dim Bezug As Long, Start As Long
    Dim i As Long, j As Long, r As Long
    
    ' formula
    Const F = "=IF(R<bezug>="""";"""";VLOOKUP(R<bezug>;'QK-Tabelle'!$B$3:$C$123;2;FALSE))" & _
              "*(R<r>/R<bezug>)+((N<r>+O<r>)*0,3+(P<r>+Q<r>)*0,1)"
    
    Start = 4
    Set ws = Worksheets("QK-Daten")
    With ws
        Set cell = .Range("R" & Start)
        For i = 0 To 179
            Bezug = cell.Offset(18).Row 'Value
            For j = 1 To 17
                r = j + (i * 18) + Start
                s = Replace(F, "<bezug>", Bezug)
                s = Replace(s, "<r>", r)
                cell.Offset(j, 8).Formula = s 'Z
            Next j
            
            ' not sure what this is doing
            ' .Range("z" & ((i * 18) + 18) + Start).Copy
            ' .Range("z" & ((i * 18) + 18) + Start).PasteSpecial Paste:=xlValues
            cell.Offset(18, 8).Value = cell.Offset(18, 8).Value
            
            ' next component
            Set cell = cell.Offset(18)
           
        Next i
    End With
    
    MsgBox "Done", vbInformation
End Sub