使用 VBA 根据另一个单元格值设置 Excel 单元格值

Question

I have the following spreadsheet. When ever there is an x in cell BI need to populate the d and e cells in the same row using an equation I have. if there is no x in the b cell I need to manually enter values into cells d & e.

How do I make my code non-row specific?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim val As String
    val = Range("B3").Value
    If val = "x" Then
        Range("E3").Value = Range("d2").Value * Range("G2").Value
        Range("D3").Value = Range("D2").Value
    End If
End Sub

Answer 1

I'm not sure if I understand correctly, but if you have a parameter: row = 3 you can use Range("E" & row) instead of Range("E3").

Put a loop around that where you vary 'row' for the rows you want to modify.

Hope that helps!

Answer 2

You've created a sub procedure around the Worksheet_SelectionChange event. In fact, you require Worksheet_Change and you need to,

• disable event handling so you can write new values/formulas to the worksheet without running the Worksheet_Change on top of itself.
• loop through each matching cell in Target to compensate for circumstances when Target can be more than a single cell,
• add error control.

Rewrite:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False
        Dim t As Range
        For Each t In Intersect(Target, Range("B:B"))
            If LCase(t.Value) = "x" Then
                'I've made these formulas relative to each target
                'you may want to make some absolute references
                t.Offset(0, 3) = t.Offset(-1, 2) * t.Offset(-1, 5)
                t.Offset(0, 2) = t.Offset(-1, 2)
            Else
                t.Offset(0, 2).resize(1, 2) = vbnullstring
            End If
        Next t
    End If

safe_exit:
    Application.EnableEvents = True

End Sub

Answer 3

Please try below code. It loop through all non empty rows in column B and check if there is value: x If so it populate your formulas.

Sub new_sub()
 ' get last_row of data
last_row = ActiveSheet.UsedRange.Rows.Count

' loop through all rows with data and check if in column B any cell contains value: x
For i = 1 To last_row
    ' if there is any cell with value: x
    ' then add below formulas
    If Cells(i, 2).Value = "x" Then
        ' for column E: take value from row above for col D and G and multiple
        Range("E" & i).Value = Range("d" & i - 1).Value * Range("G" & i - 1).Value
        ' for column D: take value from row above
        Range("D" & i).Value = Range("D" & i - 1).Value
    End If
Next i

End Sub