¿Cómo sumar varias celdas dependiendo de otras celdas en VBA?

21/10/16

Hola, Pablo

Si te entendí correctamente, esta rutina es la que estás buscando.

Entrá al Editor de VBA (Atajo: Alt + F11), allí insertá un módulo (Insertar-Módulo) y pegá el siguiente código:

Sub SumaUno()
'---- Variables modificables ----
'=== Pablo, modificá estos datos de acuerdo a tu proyecto:
    IniCelda = "B1" ' fila de títulos en hoja de destino
    MayorA = 30
'---- fin Variables
'
'---- inicio de rutina:
'  
PrimFila = Range(IniCelda).Row
UltFila = ActiveSheet.Range(Left(IniCelda, 1) & Rows.Count).End(xlUp).Row - PrimFila + 1
cont = 0
For LaLinea = 0 To UltFila
    If Range(IniCelda).Offset(LaLinea).Value > MayorA Then
        Range(IniCelda).Offset(LaLinea, -1).Value = Range(IniCelda).Offset(LaLinea, -1).Value + 1
        Range(IniCelda).Offset(LaLinea).Value = 0
        'Range(IniCelda).Offset(LaLinea).ClearContents ' quitar el apostrofo del principio de esta linea para que borre el contenido de la celda  
        cont = cont + 1
    End If
Next
ElMensaje = IIf(cont = 0, "NO SE MODIFICO CELDA ALGUNA" & Chr(10) & "porque no se encontró valor mayor a " & MayorA, "Cantidad de cambios: " & cont & " celda" & IIf(cont > 1, "s", ""))
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Como verás, al inicio podés indicarle donde empiezan los números a comparar y contra qué valor tiene que hacerlo.

Luego la rutina se encarga de saber dónde detenerse.

Habías pedido que, al cumplirse la condición, la celda de origen quede en cero. El código deja entonces un cero. Pero también tiene una linea anulada que borraría el contenido de la celda (que es distinto a que tenga un cero). Si te interesa esta opción basta que le saques el apóstrofo (') que tiene a la izquierda para que quede activa y haga eso.

Comentame si es lo que buscabas o, si necesitas más apoyo con esto, chiflame.

Un abrazo

Fernando

(Buenos Aires, Argentina)

.

Buenas, primero, gracias por responder,

Copie el código, pero al ejecutar la macro se detiene en el segundo punto de la línea if

Range(IniCelda).Offset(LaLinea, -1).Value = Range(IniCelda).Offset(LaLinea, -1).Value + 1

Ahí lo marca en amarillo y deja de ejecutarla.

Saludos.

.

Hola, Pablo

Asumiendo que hayas colocado bien la dirección de la celda inicial (donde comienza a controlar que el número sea mayor que 30), debería andar bien.

Pero también dependerá de que la celda tenga efectivamente un número real.

Puede ser que haya textos o errores que detengan ahí la rutina.

De todos modos, te mando una nueva versión que contempla esos casos.

Usá ésta versión:

Sub SumaUno()
'---- Variables modificables ----
'=== Pablo, modificá estos datos de acuerdo a tu proyecto:
    IniCelda = "B1" ' fila de títulos en hoja de destino
    MayorA = 30
'---- fin Variables
'
'---- inicio de rutina:
'  
PrimFila = Range(IniCelda).Row
UltFila = ActiveSheet.Range(Left(IniCelda, 1) & Rows.Count).End(xlUp).Row - PrimFila + 1
cont = 0
For LaLinea = 0 To UltFila
On Error Resume Next
If IsNumeric(Range(IniCelda).Offset(LaLinea)) Then
    If Range(IniCelda).Offset(LaLinea).Value > MayorA Then
        Range(IniCelda).Offset(LaLinea, -1).Value = Range(IniCelda).Offset(LaLinea, -1).Value + 1
        Range(IniCelda).Offset(LaLinea).Value = 0
        'Range(IniCelda).Offset(LaLinea).ClearContents ' quitar el apostrofo del principio de esta linea para que borre el contenido de la celda
        cont = cont + 1
    End If
End If
Next
Err.Clear
On Error GoTo 0
ElMensaje = IIf(cont = 0, "NO SE MODIFICO CELDA ALGUNA" & Chr(10) & "porque no se encontró valor mayor a " & MayorA, "Cantidad de cambios: " & cont & " celda" & IIf(cont > 1, "s", ""))
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Probalo y avisame

Abrazo

Fer

.

Gracias ahí anda bárbaro!!

Pero te consulto, yo tengo varios cuadros uno debajo del otro y al final de cada uno de los cuadros hay un total. La idea seria que en la celda que esta el total no se ejecute la macro.

Como puedo hacer para ponerle un corte en determinada ubicación, por ejemplo en la fila D?

Igual anda fantástica!

Gracias.

.

Guenas, Pablo

En el mensaje de mi perfil había colocado que estaría de vacaciones hasta hoy, de allí la demora.

Aquí va la misma rutina, con un control adicional a los que ya le había puesto que considera que la celda no tenga una fórmula para hacer lo que solicitabas.

Además antes la rutina se encargaba de determinar cuál era la última fila.

En esta versión la dejé como variable para que vos le indiques en qué número de fila terminar, atento a lo que habías pedido. (Me confundió un poco que pidas que corte en fila D cuando D es una columna,

Después me decís.

Sub SumaUno()
'---- Variables modificables ----
'=== Pablo, modificá estos datos de acuerdo a tu proyecto:
    IniCelda = "B1" ' fila de títulos en hoja de destino
    UltFila = 150 ' fila donde debe detenerse la macro
    MayorA = 30
'---- fin Variables
'
'---- inicio de rutina:
'
PrimFila = Range(IniCelda).Row
'UltFila = ActiveSheet.Range(Left(IniCelda, 1) & Rows.Count).End(xlUp).Row - PrimFila + 1
cont = 0
For LaLinea = 0 To UltFila
    If Not Range(IniCelda).Offset(LaLinea).HasFormula Then
        On Error Resume Next
        If IsNumeric(Range(IniCelda).Offset(LaLinea)) And Range(IniCelda).Offset(LaLinea) > 0 Then
            If Range(IniCelda).Offset(LaLinea).Value > MayorA Then
                Range(IniCelda).Offset(LaLinea, -1).Value = Range(IniCelda).Offset(LaLinea, -1).Value + 1
                Range(IniCelda).Offset(LaLinea).Value = 0
                'Range(IniCelda). Offset(LaLinea). ClearContents ' quitar el apostrofo del principio de esta linea para que borre el contenido de la celda
                cont = cont + 1
            End If
        End If
    End If
Next
Err.Clear
On Error GoTo 0
ElMensaje = IIf(cont = 0, "NO SE MODIFICO CELDA ALGUNA" & Chr(10) & "porque no se encontró valor mayor a " & MayorA, "Cantidad de cambios: " & cont & " celda" & IIf(cont > 1, "s", ""))
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Abrazo
Fer