Agregar fórmulas a celdas de una columna desde la celda activa, utilizando variables en las fórmulas

Busco poder crear una macro que al posesionarme en una celda y hacer clic en la macro esta agregue la fórmula absoluta desde esa celda hasta ciertas cantidad de celdas de la misma columna. Elcodigo de la primera celda seria algo como esto:

=SI(CONTAR($AB$8:$AD$8)=3;REDONDEAR((($AB$8*$AB$6)/100)+(($AC$8*$AC$6)/100)+(($AD$8*$AD$6)/100);0);"")

Para este fin cree esta macro pero se detiene en la sintaxis:

Sub Absoluto_2()
row_ini = ActiveCell.Row
col_ini = ActiveCell.Column

For i = 1 To 42
row_1 = row_ini
row_2 = row_ini
row_3 = row_ini
row_4 = 6
row_5 = row_ini
row_6 = 6
row_7 = row_ini
row_8 = 6
col_1 = col_ini - 3
col_2 = col_ini - 2
col_3 = col_ini - 3
col_4 = col_ini - 3
col_5 = col_ini - 2
col_6 = col_ini - 2
col_7 = col_ini - 1
col_8 = col_ini - 1
ActiveCell.FormulaR1C1 = "=IF(COUNT(R(row_1)C(col_1):R(row_2)C(col_2))=3,ROUND(((R(row_3)C(col_3)*R(row_4)C(col_4))/100)+((R(row_5)C(col_5)*R(row_6)C(col_6))/100)+((R(row_7)C(col_7)*R(row_8)C(col_8))/100),0),"")"
row_1 = row_1 + 1
row_2 = row_2 + 1
row_3 = row_3 + 1
'row_4 = row_4 + 1
row_5 = row_5 + 1
'row_6 = row_6 + 1
row_7 = row_7 + 1
'row_8 = row_8 + 1
'col_1 = col_1 + 1
'col_2 = col_2 + 1
'col_3 = col_3 + 1
'col_4 = col_4 + 1
'col_5 = col_5 + 1
'col_6 = col_6 + 1
'col_7 = col_7 + 1
'col_8 = col_8 + 1
row_ini = row_ini + 1
'col_ini = col_ini + 1
Next
'Range("AE1").Select
End Sub

Espero me puedan ayudar, puedo enviar el excel para un mejor entendimiento.

2 respuestas

Respuesta
1

Ya tengo el libro... pero dejaste el Editor bloqueado ;(

Sdos.

Elsa

http://aplicaexcel.com/index.htm

Te acabo de enviar el libro sin ninguna clave, gracias.

¿Sin ninguna clave? ... Mmmm, no, tenía una todavía... pero me las arreglé igual ;)

Bien, si los resultados de la imagen son correctos la fórmula para la primer celda que allí se muestra quedó así:

=SI(CONTAR($AB8:$AD8)=3;REDONDEAR((($AB8*$AB$6)/100)+(($AC8*$AC$6)/100)+(($AD8*$AD$6)/100);0);"")

Donde solo queda como absoluta la col pero no la fila salvo la fila 6 permitiendo arrastrarla hacia abajo.

Ahora, como en la macro la referencia de la celda tiene que que ver con la celda que esté seleccionada al momento de ejecutarla, confirma x favor si seleccionarás la celda con el texto NF o alguna de las verdes.

Sdos!

No me equivoque, seleccionare la primera celda que debe tener una fórmula en este caso por ejemplo la celda que tiene valor 63 en la imagen y que desde esa celda, que debe ser trabajada como la celda activa empezar a agregar las fórmulas hacia abajo.

Lo que hace la fórmula en si es tomar el valor de la celda verde calcular el porcentaje de la nota que esta en la misma columna, luego hace lo mismo con las otras 2 celdas verdes y entrega el resultado al lado. Como en la imagen.

Si Alex, me di cuenta que te habías equivocado con lo de la 'celda verde' pero mejor confirmarlo antes de avanzar.

Así queda tu macro. No hace falta recorrer todas las filas. Se coloca la fórmula en fila 8 y luego se arrastra hasta la última.

La macro contempla que estés seleccionando la celda correcta antes de ejecutarla ( para no sobreescribir en otros rangos.)

Sub Absoluto_2()
'ajustada x Elsamatilde
'controlar que se trata de una col con título NF
If Cells(6, ActiveCell.Column) <> "NF" Then
    MsgBox "Debes seleccionar la celda de fila 8 bajo el título NF."
    Exit Sub
End If
row_ini = ActiveCell.Row
col_ini = ActiveCell.Column
'col del rango
col_1 = col_ini - 3
col_2 = col_ini - 2
col_3 = col_ini - 1
'colocar fórmula en fila 8
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNT(RC" & col_1 & ":RC" & col_3 & ")=3,ROUND(((RC" & col_1 & "*R6C" & col_1 & ")/100)+((RC" & col_2 & "*R6C" & col_2 & ")/100)+((RC" & col_3 & "*R6C" & col_3 & ")/100),0),"""")"
'arrastrar hasta fila 49
ActiveCell.AutoFill Destination:=Range(Cells(8, col_ini), Cells(49, col_ini)), Type:=xlFillDefault
'opcional: seleccionar la celda de fila 8
Cells(8, col_ini).Select
End Sub
    'ActiveCell.FormulaR1C1 = "=IF(COUNT(R(row_1)C(col_1):R(row_2)C(col_2))=3,ROUND(((R(row_3)C(col_3)*R(row_4)C(col_4))/100)+((R(row_5)C(col_5)*R(row_6)C(col_6))/100)+((R(row_7)C(col_7)*R(row_8)C(col_8))/100),0),"")"

La fórmula es la que te pasé en respuesta anterior.

Sdos y no olvides valorar la respuesta.

Elsa

http://aplicaexcel.com/manuales.htm

Te recuerdo que la consulta sigue abierta. No olvides valorar las respuestas para darla por cerrada.

Sdos!

Respuesta

Te dejo por aqui lo que necesitas

Sub Absoluto()
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNT(R8C28:R8C30)=3,ROUND(((R8C28*R6C28)/100)+((R8C29*R6C29)/100)+((R8C30*R6C30)/100),0),"""")"
End Sub

Perdon no lei que querias ocupar varias celdas

Sub Absoluto()
    a = ActiveCell.Row
    b = a + 19 ' El 19 son la cantidad de espacios que se desplazara ocupando asi 20 celdas.
    For i = a To b
        ActiveCell.FormulaR1C1 = _
        "=IF(COUNT(R8C28:R8C30)=3,ROUND(((R8C28*R6C28)/100)+((R8C29*R6C29)/100)+((R8C30*R6C30)/100),0),"""")"
        ActiveCell.Offset(1, 0).Select
    Next i
End Sub

    REEMPLAZA EL '19' POR LA CANTIDAD DE CELDAS QUE DESEES BAJAR.

Estimado en primer lugar gracias por tu ayuda, pero aún no llego a lo que busco, con tu solución agregas la misma fórmula a todas las celdas, pero yo quiero usar variables para que a medida que vaya bajando cambie la fórmula y calcule las 3 celdas adyacentes, como se hace en la primera celda.

Espero me puedas entender, muchas gracias.

¿Por un lado das una formula con el rango bloqueado y por otro quieres que se mueva? Jaja

Va tu formula quedaria asi entonces

=SI(CONTAR(AB8:AD8)=3;REDONDEAR(((AB8*AB6)/100)+((AC8*AC6)/100)+((AD8*AD6)/100);0);"")

sin los bloqueos de rango

y la macro es la siguiente

Sub Absoluto()
    a = ActiveCell.Address
    b = ActiveCell.Offset(20, 0).Address ' El 20 son la cantidad de celdas que baja la macro
    c = a & ":" & b
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNT(R[2]C[-4]:R[2]C[-2])=3,ROUND(((R[2]C[-4]*RC[-4])/100)+((R[2]C[-3]*RC[-3])/100)+((R[2]C[-2]*RC[-2])/100),0),"""")"
    Selection.AutoFill Destination:=Range(c), Type:=xlFillDefault
End Sub

Recuerda cambiar el '20' por la cantidad de celdas que desees que baje......

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas