Suma...

Hola de nuevo, como ya te he comentado, por otras circunstancias ahora necesito otro tipo de rutina muy parecido a lo último que me enviaste pero con algunos cambios.
Uno de los cambios es la cantidad de artículos a controlar, ahora 612 artículos. No me quiero quedar corto y además así me puede valer para alguna otra cosita que llevo en mente hacer.
El siguiente cambio es que los 612 art. Van a estar situados en tres hojas distintas, hoja1, hoja2 y hoja3 (en cada hoja 204 art.).
En la hoja 1 las celdas de ingreso quiero que estén situadas en varios rangos:
Desde B2 hasta B35, de D2 hasta D35, de F2 hasta F35, de H2 hasta H35, de J2 hasta J35 y por ultimo de L2 hasta L35. (En total son 204)
Las celdas auxiliares donde se guarden los acumulados pueden ser las que tú quieras.
Para la hoja 2 y hoja 3 quiero hacer exactamente lo mismo. Las celdas de ingreso en estas hojas quiero que sean las mismas que hemos adjudicado para la hoja 1.
Así, podré tener 204+204+204=612 art. Controlados.
Discúlpame pero creo que cada vez te lo pongo más complicado, espero que puedas hacer algo.
Gracias.
Un saludo Miguel Ángel.

1 Respuesta

Respuesta
1
Está más complicado que el anterior, pero cuento con un 'buen manual'..:)
Si tendrás SOLO estas 3 hojas, colocá la rutina en el objeto ThisWorkbook, sino ver(*). Los rangos son fácilmente modificables y los rangos para acumular son a 26 col de la activa (para B en AB, para DE en AD y así)
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim EnRango
Dim rango1, rango2, rango3, rango4, rango5, rango6 As String
'definir los 6 rangos
rango1 = "B2:B22"
rango2 = "D2:D22"
rango3 = "F2:F22"
rango4 = "H2:H22"
rango5 = "J2:J22"
rango6 = "L2:L22"
'se controla si se está ingresando un dato en alguno de estos rangos
If Target.Column = 2 Then
'guarda la fila del registro activo
Set EnRango = Application.Intersect(Range(rango1), Target)
ElseIf Target.Column = 4 Then
Set EnRango = Application.Intersect(Range(rango2), Target)
ElseIf Target.Column = 6 Then
Set EnRango = Application.Intersect(Range(rango3), Target)
ElseIf Target.Column = 8 Then
Set EnRango = Application.Intersect(Range(rango4), Target)
ElseIf Target.Column = 10 Then
Set EnRango = Application.Intersect(Range(rango5), Target)
ElseIf Target.Column = 12 Then
Set EnRango = Application.Intersect(Range(rango6), Target)
Else
Set EnRango = Nothing
End If
If Not EnRango Is Nothing Then
'fila = Target.Row
Application.EnableEvents = False
'acumula lo que se encuentra en col AB
Target.Value = Target.Value + Target.Offset(0, 26).Value
'guarda el resultado en AB
Target.Offset(0, 26).Value = Target.Value
Application.EnableEvents = True
End If
End Sub
(*) Si tendrás + hojas donde este control NO debe hacerse, no la coloques en el objeto ThisWork... sino en cada HOJA la misma rutina, pero reemplazá la primera línea por esta:
En este caso no va en el objeto ThisWorkb

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas