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

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