使用vba在范围中的依赖单元格中添加一个公式

我想用VBA在单元格上插入一个计算。 这是我现在如何插入它。 它的工作很好，但我不能在发票单上修改百分比。 我想在插入行后，我可以修改百分比，它会自动更新销售价格。

Private Sub CommandButton1_Click() Dim wsInvoice As Worksheet, wsRange As Worksheet, wsPrice As Worksheet Dim nr As Integer, lr As Integer With ThisWorkbook Set wsInvoice = .Worksheets("Invoice") Set wsRange = .Worksheets("Range") Set wsPrice = .Worksheets("Price") End With nr = wsInvoice.Cells(Rows.Count, 1).End(xlUp).Row + 1 Select Case Me.ComboBox1 Case "Paper" wsRange.Range("Paper").Copy wsInvoice.Cells(nr, 1) lr = wsInvoice.Cells(Rows.Count, 1).End(xlUp).Row For i = nr To lr wsInvoice.Cells(i, 2) = Application.VLookup(Cells(i, 1), wsPrice.Range("A:B"), 2, 0) wsInvoice.Cells(i, 3) = (".3") wsInvoice.Cells(i, 4).Formula = FormatCurrency(wsInvoice.Cells(i, 2).Value / (1 - (wsInvoice.Cells(i, 3))), 2, vbFalse, vbFalse, vbTrue) Next i 

这是一个链接来下载我的文档。 https://drive.google.com/file/d/0By_oZy042nKWdTVmX0Fid3JVSHM/edit?usp=sharing

Answer 1

我认为这里的FormatCurrency有些没用，可以通过格式化一次这样的列来完成。 表单函数中的Formula和FormulaLocal似乎有问题。 这是我的修复：

删除行wsInvoice.Cells(i,4).Formula ...

在CommandButton1_Click（）的末尾，添加此行FormulaCorrection

在模块内部，写下这个非常简单的函数，它可以做你想做的事情：

 Sub FormulaCorrection() Sheets("Invoice").Activate lastRow = Cells(Rows.Count, 1).End(xlUp).Row For x = 2 To lastRow Cells(x, 4).FormulaLocal = "=B" & x & "/(1-C" & x & ")" Next x End Sub 

Answer 2

如果我正确地理解你，这是一个方法：

修改这一行：

 wsInvoice.Cells(i, 4).Formula = FormatCurrency(wsInvoice.Cells(i, 2).Value / (1 - (wsInvoice.Cells(i, 3))), 2, vbFalse, vbFalse, vbTrue) 

成为：

 wsInvoice.Cells(i, 4).Formula = "=" & wsInvoice.Cells(i, 2).Value & "/ (1 - (C" & i & "))" 

这似乎至less在我的testing表上起作用。

编辑：

另外，你的整个方法可以缩小一点。 这应该做同样的事情：

 Private Sub CommandButton1_Click() Dim wsInvoice As Worksheet, wsRange As Worksheet, wsPrice As Worksheet Dim nr As Integer, lr As Integer With ThisWorkbook Set wsInvoice = .Worksheets("Invoice") Set wsRange = .Worksheets("Range") Set wsPrice = .Worksheets("Price") End With nr = wsInvoice.Cells(Rows.Count, 1).End(xlUp).Row + 1 Select Case Me.ComboBox1 Case "Paper" wsRange.Range("Paper").Copy wsInvoice.Cells(nr, 1) Case "Pen" wsRange.Range("B2:B100").Copy wsInvoice.Cells(nr, 1) Case "Sticker" wsRange.Range("C2:c100").Copy wsInvoice.Cells(nr, 1) End Select lr = wsInvoice.Cells(Rows.Count, 1).End(xlUp).Row For i = nr To lr wsInvoice.Cells(i, 2) = Application.VLookup(Cells(i, 1), wsPrice.Range("A:B"), 2, 0) wsInvoice.Cells(i, 3) = (".3") wsInvoice.Cells(i, 4).Formula = "=" & wsInvoice.Cells(i, 2).Value & "/ (1 - (C" & i & "))" Next i End Sub