UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se pueden hacer consultas de Excel o VBA por mensaje privado.
Utiliza el botón buscar del foro y te ahorras tiempo para obtener "ayuda".

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

Lehoi


Hola a todos

Uso una tabla insertada que tiene en la columna E varios miles de nombres de equipos de fútbol ordenados alfabéticamente y en la columna F los países a los que pertenecen  cada uno de estos equipos.

Cuando filtro los equipos por país y selecciono algún equipo (o varios con la tecla Control), ejecuto una macro que me copia esos equipos seleccionados a otra hoja.

El problema es cuando selecciono varios equipos arrastrando el ratón y se me seleccionan también las celdas ocultas y la macro me copia muchísimos equipos que no necesito.

¿Existe alguna forma mediante macros de evitar que se seleccionen esas celdas ocultas al arrastrar el ratón sobre un rango de celdas filtradas? 

Muchas gracias y saludos

Lehoi

Igtelo


Hola Lehoi.

Arrastrando así es como trabaja (copia todo), puedes usar las teclas de End y Flechas.

Le acabo de contestar a p30691, allí puedes ver como seleccionar rangos filtrados.
http://www.universoexcelforo.com/t1947-macro-de-ordenacion#9454

Saludos
Ignacio Téllez

Lehoi


Hola Igtelo

He visto lo que me has sugerido y realmente me gusta como funciona, pero desgraciadamente no resuelve mi problema y te explico porqué.

Yo uso una macro como digo en el primer mensaje que al filtrar ya me selecciona y copia automáticamente todos los elementros filtrados a otra hoja, eso funciona ok.
El problema es que este libro no lo voy a usa solo yo, y ya sabes como es eso, explicas lo que no se debe hacer y siempre hay uno que lo hace, ya sea sin querer o a propósito.

Aunque vean un botón que ponga "Añadir equipos filtrados" si hay una lista donde hayan algunos equipos que no quieran añadir, en vez de usar el Control y click para seleccionar los que quieren, van a lo más fácil, que es arrastrar el ratón para seleccionar varios a la vez, lo que causa el problema, que los equipos ocultos también se seleccionan. 
Esto si fuera una cantidad pequeña de equipos no pasa nada, se borran en la hoja de destino y ya, pero es que los equipos seleccionados pueden ser miles.

Imagino que la solución no debe ser fácil teniendo en cuenta que hasta ahora lo que he visto que se puede hacer con el ratón es limitar su funcionalidad mientras se está ejecutando una macro usando la línea 
Application.Interactive = False  
justo antes de ejecutar el código, luego volver a habilitar el ratón con Application.Interactive = True
Pero deshabilitar la opcion de seleccionar arrastrando el ratón... lo veo chungo.

Igtelo, agradezco tu interés en ayudarme, por favor si se te ocurre alguna genialidad de las que nos tienes acostumbrados avísame y lo probaré corriendo.

Saludos !
Lehoi

Lehoi


Se me ha ocurrido una forma de solucionar el problema pero no se como llevarla a código, y es que cuando se seleccionen más celdas de las visibles, se desactive el botón que llama a la macro "Añadir_equipos_filtrados", así sería imposible añadirlos y obligaría a seguir los pasos correctos.

Cualquier sugerencia será más que bienvenida.

Lehoi


Me doy cuenta q es más fácil pensar y buscar una solución viendo el código en vez de hablar tanto jeje, aquí está el código de las macros que uso para una vez filtrados los equipos, copiar los visibles y enviarlos a la hoja "Main".

He añadido en el código de la macro "Add_Filtered_Teams" la condición de que si no hay equipos filtrados no haga nada, así no corro el riesgo que al darle al botón que llama a esta macro se añadan todos los miles de equipos a la vez.

Código:
Sub Add_Filtered_Teams()
    Dim LR As Long
    Dim lo As ListObject
    Set lo = Hoja4.ListObjects("tbl_TEAMS")
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error GoTo GetOut

    If lo.AutoFilter.Filters(2).On Then
    LR = Range("F" & Rows.Count).End(xlUp).Row
    Range("E2:E" & LR).SpecialCells(xlCellTypeVisible).Select
    Reset_Filters
    Añadir_equipo
    Exit Sub
    Else
GetOut:
MsgBox "No hay equipos filtrados, operación cancelada"
    End If
    Reset_Filters
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Esta macro Reset_Filters la uso en otras macros, por eso no la integro "Add_Filtered_Teams" y es independiente.
Código:
Sub Reset_Filters()
On Error GoTo GetOut
'    Application.ScreenUpdating = False
'    Application.Calculation = xlCalculationManual

    ActiveSheet.ListObjects("tbl_TEAMS").Range.AutoFilter Field:=3
    ActiveSheet.ListObjects("tbl_TEAMS").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("tbl_TEAMS").Range.AutoFilter Field:=1

'    Application.ScreenUpdating = True
'    Application.Calculation = xlCalculationAutomatic

    Exit Sub
GetOut:
End Sub

Esta es la macro que los envía a la hoja "Main":
Código:
Sub Añadir_equipo()
    Dim Equipo As Range
    Dim fila As Integer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Reset_Filters
    fila = WorksheetFunction.CountA(ThisWorkbook.Sheets("Main").Columns("b:b")) + 2
    For Each Equipo In Selection
    ThisWorkbook.Sheets("Main").Cells(fila, 2) = Equipo.Value
    Cells.Find(What:=Equipo.Value, After:=Range("L1"), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.FindNext(After:=ActiveCell).Activate
    
    ThisWorkbook.Sheets("Main").Cells(fila, 1) = Cells(1, ActiveCell.Column).Value
    fila = fila + 1
    Next
    Range("B1").Value = ""
    Application.Goto [B1], 1
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Beep
End Sub

Igtelo


Mi buen Lehoi.

No te compliques la existencia, con esto resuelves todo.

Saludos
Ignacio Téllez
Archivos
Lehoi.xlsm
No tienes los permisos para descargar los archivos.
(21 KB)

Lehoi


Hola Igtelo

Entiendo lo que me quisiste decir pero soy cabezón y seguí buscando como hacerlo.
Alguien me indicó una solución que la pongo aquí por si alguien le resulta interesante, a mi desde luego me resolvió un gran problema.

Código:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then
Application.EnableEvents = False
Target.Cells.SpecialCells(xlCellTypeVisible).Select
MsgBox "you selected : " & Selection.Address
Application.EnableEvents = True
End If
End Sub

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.