Formulario en Excel vba para aplicar operaciones matemáticas en rangos

Les comparto un formulario que nos sirve para aquellas ocasiones en que deseamos aplicar alguna operación matemática a los valores de un rango, o añadir un texto a cada celda de dicho rango.

Las operaciones que se podrán aplicar a los rangos elegidos son:

1. Suma.
2. Resta o sustracción.
3. Multiplicación.
4. División.
5. Potencia.
6. Unir el valor con otro.

Aplica tanto para valores de texto (&), numéricos (todas las operaciones) y fórmulas (todas las operaciones excepto &).

Cómo funciona

Se muestra un formulario en el que deberemos elegir el rango en el que deseamos aplicar la operación. En un Combobox elegiremos el signo matemático, en un TextBox ingresamos el valor a aplicar.

Código vba del formulario

':: Por favor si utilizará el código, mantén las referencias del Copyright
'
'By: Sergio Alejandro Campos, MVP Excel
'Date: 07-dic-2012
'Blog: http://blogs.itpro.es/exceleinfo
'
'Se manda llamar el procedimiento para mostrar los Labels
Private Sub cmbOperadores_Change()
Call MostrarLabel
End Sub
'
'Se ejecuta el proceso de aplicar el cálculo seleccionado
Private Sub cmdAceptar_Click()
On Error GoTo ErrorHandler
For Each Celda In Range(Me.refRAngo.Value)
    '
    'Si es número y no es fórmula
    If Application.WorksheetFunction.IsNumber(Celda.Value) _
       And Not Celda.HasFormula Then
        Select Case Me.cmbOperadores
        Case "+": Celda.Value = Celda.Value + CInt(Me.txtValor.Text)
        Case "-": Celda.Value = Celda.Value - CInt(Me.txtValor.Text)
        Case "*": Celda.Value = Celda.Value * CInt(Me.txtValor.Text)
        Case "/": Celda.Value = Celda.Value / CInt(Me.txtValor.Text)
        Case "^": Celda.Value = Celda.Value ^ CInt(Me.txtValor.Text)
        Case "&": Celda.Value = Celda.Value & Me.txtValor.Text
        End Select
    Else
        'Si la contiene una fórmula
        If Celda.HasFormula Then
            F = Celda.FormulaLocal
            Select Case Me.cmbOperadores
            Case "+": T = F & Me.cmbOperadores.Value & CInt(Me.txtValor.Text)
            Case "-": T = F & Me.cmbOperadores.Value & CInt(Me.txtValor.Text)
            Case "*": T = F & Me.cmbOperadores.Value & CInt(Me.txtValor.Text)
            Case "/": T = F & Me.cmbOperadores.Value & CInt(Me.txtValor.Text)
            Case "^": T = F & Me.cmbOperadores.Value & CInt(Me.txtValor.Text)
            Case "&":    'MsgBox "No se puede concatenar texto a fórmula", vbExclamation, "EXCELeINFO"
                Exit Sub
            End Select
            Celda.FormulaLocal = T
        Else
            Select Case Me.cmbOperadores
            Case "&": Celda.Value = Celda.Value & Me.txtValor
            Case Else
                '
            End Select
        End If
    End If
Next Celda
Exit Sub
ErrorHandler:
If Err.Number = 13 Then
    MsgBox "Los tipos de texto o número no coinciden.", vbExclamation, "EXCELeINFO"
Else
    If Err.Number = 1004 Then
        MsgBox "Por favor selecciona un rango válido.", vbExclamation, "EXCELeINFO"
    Else
        MsgBox "Ha ocurrido un error: " & Err.Number & Err.Description, vbExclamation, "EXCELeINFO"
    End If
End If
End Sub
'
'Cerrar el formulario
Private Sub CommandButton1_Click()
Unload Me
End Sub
'
Private Sub txtValor_Change()
Call MostrarLabel
End Sub
'
'Al iniciar el formulario se formatean los controles
Private Sub UserForm_Initialize()
With Me
    '
    .Frame1.ForeColor = 16711680
    .Frame1.BorderStyle = fmBorderStyleSingle
    .Frame1.BorderColor = 12632256
    '
    .lblValor.Caption = ""
    .lblOperador.Caption = ""
    .Label1.Caption = ""
    '
    .cmbOperadores.AddItem "+"
    .cmbOperadores.AddItem "-"
    .cmbOperadores.AddItem "*"
    .cmbOperadores.AddItem "/"
    .cmbOperadores.AddItem "^"
    .cmbOperadores.AddItem "&"
End With
End Sub
'
Sub MostrarLabel()
With Me
    If .txtValor <> "" And .cmbOperadores <> "" Then
        .Label1.Caption = "=CELDA"
        .Label1.Width = 30.75
        .lblValor.Caption = .txtValor.Value
        .lblOperador.Caption = .cmbOperadores.Value
    Else
        .Label1.Caption = ""
        .lblValor.Caption = ""
        .lblOperador.Caption = ""
    End If
End With
End Sub

:: Descargar el ejemplo EXCELeINFO – aplicar cálculo a celdas