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

Encontrar datos no coincidentes excel

Sucede que tengo que comparar dos bases de datos y encontrar los elementos no coincidentes para analizar. Se puede hacer por fórmula pero necesito algo más optimizado. El otro problema es que los datos son más de 1.48.576 capacidad de líneas de...
1 respuesta

¿Cómo resolver num a letras en excel?

En un libro excel habilitado para macros al convertir números a letras, en lugar de aparecer el resultado esperado aparece el mensaje # ¿NOMBRE?.
2 respuestas

´No sé que fórmulas usar para resolverme el problema

La imagen no me la sube y tampoco veo como se sube un fichero, os intentaré explicar lo mejor que pueda mi problema. En una hoja Excel tengo hallados los pagos por formas de pago: SUMAR.SI(D1:D16;"Efectivo";B1:B16), y...
3 respuestas

¿Cómo ajustar texto automáticamente en celdas combinadas en Excel 2019?

Solicito amablemente su valiosa ayuda para ajustar automáticamente un rango de celdas de una columna, he intentado con la opción de ajuste autamático de filas, también con al opción de ajustar texto de la pestaña inicio e incluso con la siguiente...
1 respuesta

¿Cómo usar un excel con macros desde varios ordenadores?

A tod@s! Tengo una aplicación en excel para introducir datos y visualizarlos con diferentes formularios creados. Lo que quiero hacer es: 1 Que ese libro este alojado en un sitio común y que lo puedan abrir desde varios ordenadores. 2º Que se pueda...
3 respuestas

Quien sabe cómo calcular el tiempo de vaciado de un tanque

Quien sabe cómo calcular en cuántas horas se vacía un tanque el cuál tiene una capacidad de 1200 litros sabiendo que cada 6,3 segundos el tanque baja 0,5 litros en cuántas horas o minuto el tanque queda vacío
2 respuestas

Error en macro al ejecutar el botón aceptar

Necesitaría la colaboración para resolver el error que sucede al ejecutar el botón aceptar Set mifila = Hoja2.ListObjects(1).ListRows.Add Lo que yo agregue solamente a la base fue una columna al inicio ("A") anteriormente se llamaba Tabla6 y yo ahora...
1 respuesta

Detectar cambios en tabla dinámica

Tengo una hoja donde se van actualizando datos mediante una tabla dinámica. ¿Cómo detecto cuando se producen cambios (sólo en la parte de la tabla dinámica) para ejecutar otra macro en la misma hoja?
1 respuesta

Macro con combinación de teclas

Acudo aquí buscando ayuda, ¿Cómo crear una macro que genere una combinación de teclas? NO se trata de asignar una macro a una combinación de teclas, es todo lo contrario. El problema radica en que tengo una macro que rellena ciertas celdas con...
1 respuesta

Pasar datos de listbox a hoja con decimales

Como están estimados maestros y maestras, una vez mas solicitando vuestra experta ayuda. Tengo un formulario que busca datos entre 2 fechas desde 2 textbox, carga en listbox lo filtrado, en la columna 2 del listbox carga valores con formato de 2...
1 respuesta