Sub MultipleD() ' Заточено под колонку "D"[4]
Dim i As Long, LastRow As Long, rTemp As Range
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
For i = 8 To LastRow
If Cells(i, "D").MergeArea.Cells.Count = 2 Then
Set rTemp = Range("D" & i)
Else
Dim s As String
s = "=R" & rTemp.Row & "C" & rTemp.Column & " * R" & Cells(i, "D").Row & "C" & Cells(i, "D").Column
If Not rTemp Is Nothing Then Cells(i, "E").FormulaR1C1 = s
End If
Next i
End Sub
Sub MultipleSel() 'Нужно выделять диапазон. Более универсален - не привязан к колонке
Dim s As String, Cell As Range, rTemp As Range
If Selection.Cells.Count = 1 Then Exit Sub
For Each Cell In Selection.Columns(1).Cells
If Cell.MergeArea.Cells.Count = 2 Then
Set rTemp = Cell
Else
s = "=R" & rTemp.Row & "C" & rTemp.Column & " * R" & Cell.Row & "C" & Cell.Column
If Not rTemp Is Nothing Then Cell.Offset(0, 1).FormulaR1C1 = s
End If
Next Cell
End Sub