Add a formula on dependant cell in range using vba

问题

I want to insert a calculation on a cell using VBA. Here is how i insert it right now. it's work pretty Good but i cannot mod the percent on the invoice sheet. I want that after i insert the row i can modify the percent and it will update automatically the selling price.

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

Here is a link to download my document. https://drive.google.com/file/d/0By_oZy042nKWdTVmX0Fid3JVSHM/edit?usp=sharing

回答1:

I think the FormatCurrency here is a bit useless, this can be accomplished by formatting the column once and leaving it like that. There seems to be an issue with the Formula and FormulaLocal inside form functions. Here's my fix :

Remove the lines wsInvoice.Cells(i,4).Formula ...

At the end of the CommandButton1_Click(), add this line FormulaCorrection

Inside a module, write down this very simple function that shall do what you want :

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

回答2:

If I understand you correctly, here is one way:

Modify this line:

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

to be:

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

That seemed to work on my test sheet at least.

Edit:

Also, your whole method can be condensed a bit. This should do the same thing:

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

来源：https://stackoverflow.com/questions/20979858/add-a-formula-on-dependant-cell-in-range-using-vba

标签

excel

vba

excel-vba