Write Excel formula using VBA into cell

Question

Like already written in my title, I am trying to overwrite wrong excel formula. But it's not really working. I copied the formula from the cell into the code and placed some double quotes to get it work. Already read, that I have to type two times " for getting a " into the formula. I can't tell what is really going on, because of companies compliance but the code should do it.

Imagine there are 180 components with the same 18 function in cells. By deleting some components I lost the reference and instead of writing every formula again, I try to do this with vba. Hope you can help me.

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

Try writing the formula with placeholders in the string and then use Replace() to substitute the values.

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