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

Posted 2023-02-18

【中文标题】使用 VBA 将 Excel 公式写入单元格

【英文标题】：Write Excel formula using VBA into cell

【发布时间】：2022-01-14 23:35:02

【问题描述】：

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

假设细胞中有 180 个组件具有相同的 18 个功能。通过删除一些组件，我丢失了参考，而不是再次编写每个公式，我尝试使用 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

【问题讨论】：

你尝试在范围上写公式，还是在公式结果上写？对于第一个变体，请将.value 替换为Formula，将FALSCH 替换为FALSE。 VBA 不关心本地化。或者尝试使用FormulaLocal 并保持本地化...

哦，对不起，也许我必须用英语编写代码。它实际上是德语。对此感到抱歉。是的，它是我尝试的第一个。我像你说的那样改变了它，但仍然不起作用。也将“=wenn...”改为“=if...”，但没有区别。

这里真的经常被问到（和回答）。我的建议：手动将正确的公式写入 Excel，转到 VBA 编辑器并将公式转储到即时窗口 (? ActiveCell.Formula)。这将向您展示 Excel 期望公式的样子。另外，不要将公式直接写入单元格，使用中间变量，这有助于调试。在您的情况下，您需要将 ; 替换为 , 作为公式参数的分隔符。

我做到了，然后发生了一些奇怪的事情：原来是“...$R$22..”，但 vba 创建了这个：“...R22C18...”。还将“..R16/$R$22..”更改为“..R[1]C[-14]/R22C18..”第二个字母是从哪里来的？

知道了。问题解决了。对于有同样问题的人，这里要检查的代码：Worksheets("QK-Daten").Range("Z" & j + (i * 18) + Puffer).Value = "=IF(R" & ((i * 18) + 18) + Puffer & "="""","""",VLOOKUP(R" & ((i * 18) + 18) + Puffer & ",'QK-Tabelle'!$B$3:$C$123,2,FALSE))*(R" & j + (i * 18) + Puffer & "/R" & ((i * 18) + 18) + Puffer & ")+((N" & j + (i * 18) + Puffer & "+O" & j + (i * 18) + Puffer & ")*0.3+(P" & j + (i * 18) + Puffer & "+Q" & j + (i * 18) + Puffer & ")*0.1)" 我编辑了一些变量，但是获取函数的规则应该很清楚。

【参考方案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

【讨论】：

在每个组件的第 1 到 17 行中，我需要一个公式。最后一个单元格有时会手动插入值，有时它基于旧公式。所以我只是复制该值并将其粘贴为单元​​格中的数字以摆脱公式。