El procedimiento es demasiado largo

La cosa esta así, tengo dos hojas, una contiene datos de vendedores y ciertos modelos de productos, en la otra contiene las ventas de dichos productos más explicito.

La cosa es que en las celdas que marca con cantidades, al seleccionar dicha celda, filtre en la segunda hoja por el vendedor y el modelo del producto correspondiente a la fila y a la columna. Son 7 columnas de 100 filas cada una, hasta ahora lo he podido lograr haciéndolo celda por celda, sin embargo, para cada celda son 7 líneas de código, al llegar a la celda 130 de la primer columna sin problema lo ejecuta, sin embargo, cuando ya son más me regresa el mensaje de procedimiento demasiado largo, ES SENCILLO EL CÓDIGO MI PROBLEMA ES QUE NO SE COMO RESUMIRLO
Les envío el código como lo tengo, los rangos son de la d4 a la d100 y hasta la columna j, las celdas que debe seleccionar para el filtro son (dependiendo de la columna en cuestión) fila 3 y la columna b, en caso de que el valor sea 0 o inferior no hacer nada

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Sheets("gral").Range("D4").Value > 0 Then
If Not Intersect(Target, Range("D4")) Is Nothing Then
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("D3").Value & "*"
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=7, Criteria1:="*" & Sheets("GRAL").Range("C4").Value & "*"
Else
End If
Else
End If
If Sheets("gral").Range("D5").Value > 0 Then.... Etc

End Sub
Si pudieran ayudarme con esto por favorsote ya que es para terminar un reporte que me esta volviendo loco ja ja

1 respuesta

Respuesta
1

Para poder optimizar o resumir un código es necesario conocer un patrón o algo similar en todas las rutinas, para con ello fabricar el nuevo código.

En este caso solamente pusiste una rutina, es necesario que pongas 4 o 5 rutinas para identificar esas similitudes.

Copia 5 de tus rutinas y me explicas qué es lo que cambia en cada rutina. También dime en cuál hoja estás poniendo el evento SelectionChange.

claro intentare ser un poco mas claro y resumido.
tengo en un solo archivo 10 hojas:
GRAl,ventas,pcm,vcm,pcr,vcr,vecm,vecr,vcrr,hoja1
el selection change esta en la hoja gral, los filtros en la hoja de ventas
dentro de la hoja gral tengo informacion de sumas de ventas del modelo que esta en la fila 3, en la columna b tengo a todos los vendedores de la empresa, en el rango "D4:J100" tengo la informacion de la suma de las ventas de cada vendedor por cada modelo de impresora, la funcion es que cuando yo seleccione la celda x, si el valor es igual a 0 no haga nada, en caso contrario, los filtros de modelo y vendedor de la hoja de ventas, tomen el valor de la columna y la fila donde se encuentre dicha celda, lo probe con una celda e intente cambiar solamente la celda dentro de la primer columna al llegar a la 100 el sistema me indica que el procedimiento es demasiado largo, no se como resumirlo de tal forma que cuando el valor de la celda seleccionada en este rango tome el encabezado de la columna y la fila correspondiente para no hacerlo repetitivo, la funcion que realice que me funciono es la siguiente:

//se hace en la hoja general

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
//todo comienza en la fila 4 de las columnas d,e,f,g,h,i,j y cambia cuando el usuario selecciona cada celda de este rango hasta la fila 100
If Sheets("gral").Range("D4").Value > 0 Then 

// cambia conforme a la celda seleccionada

If Not Intersect(Target, Range("D4")) Is Nothing  Then

//si la celda es seleccionada entonces filtra en la hoja de ventas del camo 3 y 7 el contenido de la columna en la fila 3 y el contenido de la columna c y la fila correspondiente a la celda

Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("D3").Value & "*"
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=7, Criteria1:="*" & Sheets("GRAL").Range("C4").Value & "*"
Else
End If
Else
End If

// y asi consecutivamente por cada celda por cada columna, los valores estan dentro d eun rango no de una tabla
If Sheets("gral").Range("D5").Value > 0 Then
If Not Intersect(Target, Range("D5")) Is Nothing Then
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("D3").Value & "*"
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=7, Criteria1:="*" & Sheets("GRAL").Range("C5").Value & "*"
Else
End If
Else
End If
If Sheets("gral").Range("D6").Value > 0 Then
If Not Intersect(Target, Range("D6")) Is Nothing Then
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("D3").Value & "*"
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=7, Criteria1:="*" & Sheets("GRAL").Range("C6").Value & "*"
Else
End If
Else
End If
If Sheets("gral").Range("D7").Value > 0 Then
If Not Intersect(Target, Range("D7")) Is Nothing Then
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("D3").Value & "*"
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=7, Criteria1:="*" & Sheets("GRAL").Range("C7").Value & "*"
Else
End If
Else
End If
If Range("D8").Value > 0 Then
If Not Intersect(Target, Range("D8")) Is Nothing Then
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("D3").Value & "*"
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=7, Criteria1:="*" & Sheets("GRAL").Range("C8").Value & "*"
Else
End If
Else
End If
If Range("D9").Value > 0 Then
If Not Intersect(Target, Range("D9")) Is Nothing Then
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("D3").Value & "*"
Sheets("VENTAS").Range("$A$1:$H$1").AutoFilter FIELD:=7, Criteria1:="*" & Sheets("GRAL").Range("C9").Value & "*"
Else
End If
Else
End If
End Sub
intente explicarlo lo mejor posible comentame si es necesario que te mande el archivo

Pues, haber si entendí.

Lo único que cambia en tus rutinas es la celda del target D4, D5, D6, etc.

Y el filtro en el campo siete cambia a C4, C5, C6 etc.

Entonces si selecciono una celda en la columna D, el filtro 7 debe tomar lo que está en la columna C, si eso es correcto, te anexo la macro actualizada

Cambia toda tu macro por esta macro:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Por.Dante Amor
    If Target.Count > 1 Then Exit Sub
    If Target.Value <= 0 Then Exit Sub
    If Not Intersect(Target, Range("D4:D" & Range("D" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        With Sheets("VENTAS").Range("$A$1:$H$1")
            .AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("D3").Value & "*"
            .AutoFilter FIELD:=7, Criteria1:="*" & Target.Offset(0, -1).Value & "*"
        End With
    End If
End Sub

Eso es lo único que veo en las líneas que pusiste.

Lo que me queda duda es por qué marcas la celda "D3", en negritas, a caso, también debe cambiar en la macro, entonces tienes que poner 4 ejemplos para ver las similitudes.

Si falta algo envíame tu archivo para revisarlo.

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

¡Gracias! Quedo excelente al principio no sabia como cambiar los datos de la columna pero ya lo logre les envío el código y espero que le spueda ayudar a alguien más a realizarlo ya que buscando en internet no vi como hacer que de un solo resultado se aplicara a dos filtros muchas gracias dante les envío el código

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
If Target.Value <= 0 Then Exit Sub
If Not Intersect(Target, Range("D4:D" & Range("D" & Rows.Count).End(xlUp).Row)) Is Nothing Then
With Sheets("VENTAS").Range("$A$1:$H$1")
.AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("D3").Value & "*"
.AutoFilter FIELD:=7, Criteria1:="*" & Target.Offset(0, -1).Value & "*"
End With
End If
If Target.Count > 1 Then Exit Sub
If Target.Value <= 0 Then Exit Sub
If Not Intersect(Target, Range("E4:E" & Range("E" & Rows.Count).End(xlUp).Row)) Is Nothing Then
With Sheets("VENTAS").Range("$A$1:$H$1")
.AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("E3").Value & "*"
.AutoFilter FIELD:=7, Criteria1:="*" & Target.Offset(0, -2).Value & "*"
End With
End If
If Target.Count > 1 Then Exit Sub
If Target.Value <= 0 Then Exit Sub
If Not Intersect(Target, Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row)) Is Nothing Then
With Sheets("VENTAS").Range("$A$1:$H$1")
.AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("F3").Value & "*"
.AutoFilter FIELD:=7, Criteria1:="*" & Target.Offset(0, -3).Value & "*"
End With
End If
If Target.Count > 1 Then Exit Sub
If Target.Value <= 0 Then Exit Sub
If Not Intersect(Target, Range("G4:G" & Range("G" & Rows.Count).End(xlUp).Row)) Is Nothing Then
With Sheets("VENTAS").Range("$A$1:$H$1")
.AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("G3").Value & "*"
.AutoFilter FIELD:=7, Criteria1:="*" & Target.Offset(0, -4).Value & "*"
End With
End If
If Target.Count > 1 Then Exit Sub
If Target.Value <= 0 Then Exit Sub
If Not Intersect(Target, Range("H4:H" & Range("H" & Rows.Count).End(xlUp).Row)) Is Nothing Then
With Sheets("VENTAS").Range("$A$1:$H$1")
.AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("H3").Value & "*"
.AutoFilter FIELD:=7, Criteria1:="*" & Target.Offset(0, -5).Value & "*"
End With
End If
If Target.Count > 1 Then Exit Sub
If Target.Value <= 0 Then Exit Sub
If Not Intersect(Target, Range("I4:I" & Range("I" & Rows.Count).End(xlUp).Row)) Is Nothing Then
With Sheets("VENTAS").Range("$A$1:$H$1")
.AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("I3").Value & "*"
.AutoFilter FIELD:=7, Criteria1:="*" & Target.Offset(0, -6).Value & "*"
End With
End If
If Target.Count > 1 Then Exit Sub
If Target.Value <= 0 Then Exit Sub
If Not Intersect(Target, Range("J4:J" & Range("J" & Rows.Count).End(xlUp).Row)) Is Nothing Then
With Sheets("VENTAS").Range("$A$1:$H$1")
.AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Range("J3").Value & "*"
.AutoFilter FIELD:=7, Criteria1:="*" & Target.Offset(0, -7).Value & "*"
End With
End If

End Sub

Funciona al 100 aunque si se tarda un poco al hacer el recalculo, excelente!

Quedaría resumido todo el código en esto:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Por.Dante Amor
    If Target.Count > 1 Then Exit Sub
    If Target.Value <= 0 Then Exit Sub
    u = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
    If Not Intersect(Target, Range("D4:J" & u)) Is Nothing Then
        With Sheets("VENTAS").Range("$A$1:$H$1")
            .AutoFilter FIELD:=3, Criteria1:="*" & Sheets("GRAL").Cells(3, Target.Column).Value & "*"
            .AutoFilter FIELD:=7, Criteria1:="*" & Sheets("GRAL").Cells(Target.Row, "C").Value & "*"
        End With
    End If
End Sub

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Pasar de hoja resumen a plantilla de factura

Tengo un Excel, con un hoja resumen de datos, y lo que quisiera hacer, es que me pasara los datos que tengo en cada línea de la hoja resumen de forma de forma automática, a diferentes hojas de excel del mismo libro, en unas celdas concretas,...
2 respuestas

Buscar la ultima fecha de mantenimiento

Tengo una tabla de excel hoja2 que cuando escribo el numero de activo del equipo en la columna A me busca los datos como el nombre del equipo, marca, serie y modelo. Estos datos provienen de la hoja 1. Lo que quiero hacer es que al digital el activo...
2 respuestas

Promedio de las ultimas 100 celdas con numeros

Tengo en la columna 0Y2:OY146 (celdas en blanco y celdas con numeros necesito calcular el promedio de los ultimos 100 numeros de la columna, si la cantidad fuera inferior a 100 que calcule el promedio de la totalidad de las celdas que contenga numeros.
2 respuestas

Tengo una base de datos en access para cobrar cuotas

En la cual genere formulario que muestra un resumen de las cuotas pagadas ¿Cómo puedo enviar cada formulario por mail?
2 respuestas

Proyecto de imanes

Tengo que realizar un proyecto de ciencias, y quiero saber si es posible hacer un proyecto con imanes. La idea que tengo en mente es colocar los imanes en posiciones predeterminadas(en las esquinas, en los latelales) dentro de un espacio cerrado como...
4 respuestas

No encuentro como usar bien la función sumar.si

He probado con el sumar. Si, y no encuentro la fórmula para que, en D1, me de la suma de B7:B18, sumada a la D7:D18, mientras que el mes de las celdas A7:A18 sea igual a Marzo. Y que en D2 hiciera lo mismo, pero para el mes de abril. Muchas gracias
1 respuesta

Buscar un valor que coincida con dos nombres y en diferentes tablas

Necesito buscar un valor que proviene de una tabla dinámica que se va actualizando por mes y tiene dos características y buscar el valor en diferentes tablas.
Sin respuestas

Buscar un valor en un rango que coincida con dos nombres y en diferentes tablas

Necesito buscar un valor que viene de una tabla dinámica con dos características y hay que buscarlo dentro de un rango en diferentes tablas que coincidan con el nombre.
Sin respuestas

Si se contesta sin pensar a un test de 10 prguntas en las que hay que contestar si es cierto o falso...

Si se contesta sin pensar un test de 10 preguntas en las que hay que contestar si es cierto o falso. ¿Cuál es la probabilidad de acertar el 70 % o mas de las preguntas?, ¿Y exactamente 7 de las 10 respuestas?
2 respuestas

Ley de tercios en casinos

Me puedes ayudar por favor con este tema para ver como funciona matemáticamente.
10 respuestas