Los "N..." mejores (formulario)

publicado el 4 de septiembre15 años

Hola a todos!

Hoy quiero compartir con ustedes, un archivo que muestra los "n" mejores... de una tabla, por medio de un formulario, este consiste en que deseamos ver dentro del formulario, segun el numero de "top" que elegimos, mejor vean el adjunto y ojala le sirva a alguien:)

Nota: en relaidad es un filtro mejorado (comodo) y adaptado a un formulario

Cualqiuer mejora o algo mejor pues aqui esperamos:D

Private Sub TextBox1_Change()

    Dim uf

    Application.ScreenUpdating = False
    On Error Resume Next

    With Sheets("sheet1")

        Cells.Rows.Hidden = False
        ListBox1.RowSource = Empty
        If ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
        End If
        Range("A32").CurrentRegion.ClearContents

        If TextBox1 <= 0 Then
            MsgBox "Indique el Top porfavor... debe ser mayor a 0"
            ListBox1.RowSource = Empty
            If ActiveSheet.FilterMode Then
            ActiveSheet.ShowAllData
            End If
            Range("A32").CurrentRegion.ClearContents
            TextBox1 = ""
            Me.TextBox1.SetFocus
            Exit Sub
        End If

        If Me.TextBox1 <> "" Then
        With Range("A1").CurrentRegion
            .AutoFilter 3, TextBox1, xlTop10Items
            .Copy
            With .SpecialCells(xlCellTypeVisible)
            Range("A32").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Range("A1").Select
            End With
        End With
        Me.TextBox1.SetFocus
        End If

        ListBox1.RowSource = "A32:C100"

        uf = Cells(65536, 1).End(xlUp).Row
        For g = 32 To uf
            If Cells(g, 1) <> "" Then Rows(g).Hidden = True
        Next

    End With

    On Error GoTo 0
    Application.ScreenUpdating = True

End Sub

Private Sub CommandButton1_Click()

    ListBox1.RowSource = Empty
    If ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    End If
    Range("A32").CurrentRegion.ClearContents
    TextBox1 = ""
    Me.TextBox1.SetFocus
    Exit Sub

End Sub[/PHP]

Saludos desde Honduras

Los 5 mejores.zip

publicado el 4 de septiembre15 años

Re: Los "n" mejores (formulario)

¡ Bravo Gerson !

Me ha gustado mucho.

No conocía



If ActiveSheet.FilterMode Then

   ActiveSheet.ShowAllData[/CODE]

Gracias. Un saludo.

"Macro" Antonio.

publicado el 4 de septiembre15 años

Re: Los "n" mejores (formulario)

Saludos a todos, gracias por mostrarnos este formidable codigo, muy bueno.

Tengo una duda, a ver si me pueden aclarar.

Si deseara que los Tops se ordenaran descendentemente, que deberia cambiar?

Otra cosa, al buscar los 4 Tops, en lugar de 4 muestra 5. Donde podria buscar el fallo?

Gracias y disculpas por la curiosidad

publicado el 4 de septiembre15 años

Autor

Re: Los "n" mejores (formulario)

Macro (antes Antoni jejeje, porque te cambiaste el nombre???), gracias por tus comentarios, y las lineas a las cuales haces mencion son muy utiles para no ir al menu de Excel, es muy practico, si encuentra el modo filtro muestra todos los datos

himself como estas

Si deseara que los Tops se ordenaran descendentemente, que deberia cambiar?
Otra cosa, al buscar los 4 Tops, en lugar de 4 muestra 5. Donde podria buscar el fallo?

Segun tu primera pregunta, he adaptado y cambiado un poco la macro (espero te guste) y la segunda tienes razon, pero como Excel tiene muchas curiosidades, una de ellas es esta, y don Excel los muestra porque hay dos valores iguales (64) en dos registros, prueba cambiando uno de ellos a 63 o 65, y vuelve a filtrar y notaras el cambio....

Mi estimado Luis

Por los momentos tengo que salir corriendo... y no tengo mas tiempo para describir la macro, pero en futuros aportes tratare de hacerlo, aunque mencionarte que es a libre voluntad para quienes lo deseen hacer (yo por mi lado con gusto, ya sabes a la orden)

Adjunto de nuevo el aporte y espero que agrade mas, y si hay mas mejoras pues adelante que nos servira a todos

Saludos desde Honduras

Los 5 mejores.zip

publicado el 4 de septiembre15 años

Re: Los "n" mejores (formulario)

Muchas gracias por la respuesta, Gerson Pineda-El Catracho.

De verdad que cuando veo personas como tu, llenas de conocimiento y con tanto deseo de enseñar, me dan mas ganas de superarme y hacer lo mismo. Muchas gracias a cada uno de los que aqui, nos ayudan a crecer, cada dia mas, sin pedir nada a cambio. Mucho exito a todos.

publicado el 4 de septiembre15 años

Autor

Re: Los "n" mejores (formulario)

Hola de nuevo

A peticion de mi amigo Luis

Private Sub TextBox2_Change()

    'Declarar la variable uf
    Dim uf

    'Desactivar el parpadeo de la pantalla
    Application.ScreenUpdating = False

    'Saltar cualquier error
    On Error Resume Next

    'Seleccionar la hoja para filtrar
    With Sheets("Filtro")

        'Mostrar cualquier fila escondida
        Cells.Rows.Hidden = False

        'Limpiar el listbox
        ListBox1.RowSource = Empty

        'Desactivar si el filtro esta modo activo y mostrar los registros
        If ActiveSheet.FilterMode Then
            ActiveSheet.ShowAllData
        End If

        'Marcar el rango desde A32 hasta donde existan datos (hacia la derecha y hacia abajo) _
        o sea el rango usado, limapiar y quitar color de celdas
        With Range("A32").CurrentRegion
            .Clear
            .Interior.Color = xlNone
        End With

        'Si el textbox es menor o igual a cero, que proceda...
        If Me.TextBox2.Value <= 0 Then
            MsgBox "Indique el Top porfavor... debe ser mayor a 0"
            Cells.Rows.Hidden = False
            ListBox1.RowSource = Empty
            If ActiveSheet.FilterMode Then
                ActiveSheet.ShowAllData
            End If
            With Range("A32").CurrentRegion
                .Clear
                .Interior.Color = xlNone
            End With
            'Limpiar el textbox y activar cursor en el mismo
            Me.TextBox2 = ""
            Me.TextBox2.SetFocus
            Exit Sub
        End If

        'Si el textbox es diferente a campo vacio
        If Me.TextBox2.Value <> "" Then
        With Range("A1").CurrentRegion
            'Filtrar por la columna C, segun el Top/Mejor numero
            .AutoFilter 3, Me.TextBox2.Value, xlTop10Items
            .Copy
            'Pegar solo los datos visibles, desde A32
            With .SpecialCells(xlCellTypeVisible)
            Range("A32").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            'Ordenar los datos pegados, segun el orden ingresado
            With Range("A32").CurrentRegion
                .Sort Range("C33"), Me.TextBox1.Value, Header:=xlGuess
            End With
            Range("A1").Select
            End With
        End With
        End If

        'Mostrar los datos en el listbox
        ListBox1.RowSource = "A32:C100"

        'Crear el siclo o bucle para ocultar las filas que se muestran en listbox (para estetica)
        uf = Cells(65536, 1).End(xlUp).Row
        For g = 32 To uf
            If Cells(g, 1) <> "" Then Rows(g).Hidden = True
        Next

    End With

    'Anular o desactivar cualquier error inniciado
    On Error GoTo 0
    'Activar la pantalla
    Application.ScreenUpdating = True

End Sub

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    ListBox1.RowSource = Empty
    Cells.Rows.Hidden = False
    If ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If
    With Range("A32").CurrentRegion
        .Clear
        .Interior.Color = xlNone
    End With
    Me.TextBox1 = ""
    Me.TextBox2 = ""
    Me.TextBox1.SetFocus
    Exit Sub
    Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
'Al iniciar el fornulario, activar el cursor en el textbox
Me.TextBox1.SetFocus
End Sub

Private Sub TextBox1_Change()
'Si el numero para ordenar los datos es mayor a 2, que proceda...
If Me.TextBox1.Value > 2 And Me.TextBox1.Value <> "" Then
    MsgBox "Ingrese solamente: el # 1 (orden ascendente) o # 2 (orden descendente)"
    Me.TextBox1 = ""
    Me.TextBox2 = ""
    Me.TextBox1.SetFocus
    Exit Sub
End If
End Sub
[/PHP]

Y subo el archivo, le agregue algo mas para restringir la entrada de valores...

Saludos desde Honduras

Los 5 mejores _.zip

publicado el 5 de septiembre15 años

Re: Los "n" mejores (formulario)

Hola Gerson

Aunque en estos momentos mis conocimientos de VBA son muy rudimentarios, valoro tu trabajo y disposición a ayudar (que vienen siendo tus señas de identidad). Esta contribución tuya - me guío por las palabras de Luis y Himself - tiene que ser muy importante para la programación, por lo que la tendré muy en cuenta cuando progrese en macros y alcance a comprenderla.

Un saludo

publicado el 6 de septiembre15 años

Autor

Re: Los "n" mejores (formulario)

Hola mi estimado Fleming

Creeme que yo estoy en pañales con VBA, solo que cada dia intento seguir aprendiendo de los que mas saben (claro con lo que se, ayudo con gusto:))

Saludos

publicado el 6 de septiembre15 años

Autor

Re: Los "n" mejores (formulario)

Muchas gracias por la respuesta, Gerson Pineda-El Catracho.
De verdad que cuando veo personas como tu, llenas de conocimiento y con tanto deseo de enseñar, me dan mas ganas de superarme y hacer lo mismo. Muchas gracias a cada uno de los que aqui, nos ayudan a crecer, cada dia mas, sin pedir nada a cambio. Mucho exito a todos.

himself de verdad gracias por tus comentarios y elogios... asi que ya sabes

Saludos

5 years later...

publicado el 23 de febrero9 años

hola amigo gerson.

Primeramente te saludo, y admiro tus conocimiento, por lo cual solicito tu ayuda en el desarrolo de mi problema.

Mira yo tengo archivo con dos Hojas Hoja1 y Hoja2 y un formulario en la cual esta un listbox de una hoja1 que con solo cliquear me carga en los textbox, lo que necesito es que cuando escriba en el textbox lo filtre en el listbox y nuevamente cliqueando en el listbox cargue los datos ya filtrados te dejo el codigo ya que no se puede cargar el archivo, agradezco de ante mano tu apoyo.

Private Sub CommandButton1_Click()
Dim fila As Integer
'No pude seleecionar la hoja Datos, pero si escribir directamente diciéndole el lugar.
With Worksheets("StandBy")
     fila = .Range("A" &amp; Cells.Rows.Count).End(xlUp).Offset(1).Row
     .Range("B" &amp; fila) = ComboBox3.Value
     .Range("C" &amp; fila) = TextBox2.Value
     .Range("E" &amp; fila) = TextBox4.Value
     .Range("H" &amp; fila) = TextBox7.Value
     .Range("F" &amp; fila) = TextBox5.Value
     .Range("A" &amp; fila) = TextBox8.Value
     .Range("I" &amp; fila) = TextBox10.Value
     .Range("G" &amp; fila) = ComboBox1.Value
     .Range("D" &amp; fila) = ComboBox2.Value
End With
MsgBox ("DATOS TRANSFERIDOS")
' Limpia los campos de la entrada de los textbox
Me.ComboBox3.Value = ""
Me.TextBox2.Value = ""
Me.TextBox4.Value = ""
Me.TextBox7.Value = ""
Me.TextBox5.Value = ""
Me.TextBox10.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Rem Textbox1.SetFocus Envía el cursor al Textbox1 para volver a capturar los datos
ComboBox3.SetFocus
End Sub

Private Sub CommandButton2_Click()
UserForm2.Hide
End Sub

Private Sub ListBox1_Click()
fila = ListBox1.ListIndex + 2
    With Hoja6.Range(ListBox1.RowSource)
        TxtFiltro1.Text = .Offset(ListBox1.ListIndex, 0).Resize(1, 1).Value
        TextBox4.Text = .Offset(ListBox1.ListIndex, 1).Resize(1, 1).Value
    End With
End Sub

Private Sub TxtFiltro1_Change()
Application.ScreenUpdating = False '&lt;---  adaptacion
nombre = Val(TextBox1)
Sheets("Stock StandBy").Unprotect
Sheets("Stock StandBy").Activate
Cells.EntireRow.Hidden = False
uf = Range("A" &amp; Cells.Rows.Count).End(xlUp).Row
If nombre = "" Then Exit Sub
'==========================adaptacion===============================
ListBox1.RowSource = "": ListBox1.ColumnCount = 3
Dim Datos(1000, 2) 'dimensiones de la matriz
Dim matriz_1 As Integer
matriz_1 = -1
For fil = 0 To uf

    If Range("a" &amp; fil + 2) &lt;&gt; nombre Then
            'oculta las filas
            Rows(fil + 2 &amp; ":" &amp; fil + 2).EntireRow.Hidden = True
            GoTo line1
        Else 'si es igual,entonces
            'agrega los datos a la matriz
           matriz_1 = matriz_1 + 1
           For j = 0 To 7
            Datos(matriz_1, j) = Cells(fil + 2, j + 1)

           Next j
    End If
line1:
Next fil

ListBox1.List = Datos 'carga el listbox con la matriz(24 filas y 4 col)
'depura el listbox con datos vacios 
'For i = ListBox1.ListCount - 1 To 0 Step -1
'   On Error Resume Next
'   If ListBox1.List(i).Column(2) &lt;&gt; Val(TextBox1) Then ListBox1.RemoveItem (i)
'Next
'========================fin de adaptacion===========================
Sheets("Stock StandBy").Protect
Sheets("Reguistro").Activate

End Sub

Private Sub UserForm_Activate()
TextBox8 = Date

End Sub

Private Sub UserForm_Initialize()
'mostramos hoja2
Hoja6.Visible = xlSheetVisible
Hoja6.Select
Me.ListBox1.Clear
'cargamos los datos del inventario en el listbox1
Me.ListBox1.RowSource = "a5:c" &amp; Hoja6.Range("A" &amp; Rows.Count).End(xlUp).Row
With ListBox1
    'le decimos cuantas columnas tine
    .ColumnCount = 3
    'le decimos que tiene encabezado
    .ColumnHeads = True
    'le decimos los espacios para los datos
    .ColumnWidths = "180 pt;60 pt;70 pt"
End With
'ocultamos la hoja2
Hoja6.Visible = xlSheetVeryHidden
'refrescamos pantalla
Application.ScreenUpdating = True
End Sub

Atte.

Palacios

publicado el 23 de febrero9 años

Autor

Hola Ricardo

Gracias por tus comentarios y se bienvenido pero por favor lee las normas del foro (por varias razones)

Una de las razones principales es que en esta sección no se hacen consultas

Saludos

publicado el 23 de febrero9 años

te adjunto el archivo, para mas detalles gracias

ControlSalida.rar

publicado el 23 de febrero9 años

Autor

te adjunto el archivo, para mas detalles gracias

Hola Ricardo
Gracias por tus comentarios y se bienvenido pero por favor lee las normas del foro (por varias razones)

Una de las razones principales es que en esta sección no se hacen consultas

Saludos

Se nota que no leíste mis comentarios

Saludos

publicado el 23 de febrero9 años

hola gerson,

disculpa esque soy nuevo aqui, si los leí, y trate de dar solución con el buscador y no lo encuentro y es por eso que solicito tu ayuda aver si me orientas para poder solicitar la ayuda gracias amigo gerson

publicado el 23 de febrero9 años

ok amigo gerson ya corregi y subi mi informacion como se debe, te agradecere bastante tu apoyo con el problema que tengo gracias.

publicado el 23 de febrero9 años

Autor

Crea un tema en la seccion de Macros

Saludos

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

Domina Excel, de Cero a Experto

¿Atascado? Deja de buscar soluciones puntuales. Aprende a dominar Excel para siempre con nuestro curso online. Más de 115 lecciones y soporte directo.

Ver el Curso Completo

193 Archivos
99 Comentarios
30 Revisiones
Última descarga

Agenda Calendario Vintage
- 2

Fechas Móviles

Saludos adjunto el archivo con cinco ejemplos distintos con los respectivos resultados esperados para el mes de octubre de 2025 y 2026:
Primer Viernes de Octubre 03/10/2025 - 02/10/2026
Segundo Jueves de Octubre 09/10/2025 - 08/10/2026
Tercer Miércoles de Octubre 15/10/2025 - 14/10/2026
Tercer Martes de Octubre 21/10/2025 - 20/10/2026
Cuarto Lunes de Octubre 27/10/2025 - 26/10/2026
En cuanto a la forma de calcular estas son las formulas utilizadas en el video para el tercer Viernes de Agosto de 2021:
Primero se calcula el primer día del mes:
FECHANUMERO("01/"&S7&R7)

Luego se calcula que día de la semana cae el primer día del mes:
DIASEM(B5;2)
Luego se resta el numero del día que corresponde al Viernes (5) menos el numero del día que corresponde primer día del mes (Domingo (7))
X7-7

Si el resultado anterior es ≥ 0 entonces se resta los días hábiles existentes entre el primer día del mes y el día anterior a la fecha buscada en caso contrario se suma el total de días hábiles en el mes
SI(S14>=0;Y7+S14;Z7+S14)

Por ultimo al resultado anterior se le suma la fecha inicial y se obtiene la fecha y correspondiente al día buscado;
SI(S14>=0;Y7+S14;Z7+S14)+T7
Feriados Moviles (B).xlsx

Por jues, · publicado hace 15 horas 15 hr
Fechas Móviles

...la tabla no queda bien...
Adjunto archivo.
Feriados Moviles (B).xlsx

Por Victor7, · publicado el martes a las 19:453 días
Fechas Móviles

Lo siento, pero voy a repetirme sobre lo que dije en mi anterior intervención: "Sería interesante que explicaras con detalle qué es lo que falla de tu archivo, por qué, y qué es lo que buscas obtener".
A ver si así avanzamos: Supongamos que tienes esta tabla:
Inicial
Final
Inicial
Final
Ajuste
Dia Habil
Habiles
Habiles
Año
2025
2026
01/10/2025
31/10/2025
01/10/2026
31/10/2026
5
5
23
23

01/10/2025
31/10/2025
01/10/2026
31/10/2026
3
4
23
23

01/10/2025
31/10/2025
01/10/2026
31/10/2026
2
7
23
23

01/10/2025
31/10/2025
01/10/2026
31/10/2026
7
3
23
23

¿Qué 4 fechas concretas deberían aparecer en cada una de las 2 últimas columnas?
¿Cómo se llega a ellas? ¿Qué cálculos son necesarios?

Por Victor7, · publicado el martes a las 19:393 días
Fechas Móviles

Saludos Sr @Victor7
Con este cuadro lo que pretendo es poder obtener cualquier fecha móvil existente en el calendario festivo y que la misma se actualice de manera automática en las Celdas AB y AC sin la necesidad de hacer ajustes posteriores de allí que tome las formulas que se muestran en el tutorial y las fui anidando de forma tal que pudiera obtener el mismo resultado del ejemplo por lo cual es conveniente indicar que de acuerdo al ejemplo del tutorial:
Celda X: Aquí se introduce manualmente el número del día de la semana donde se ubica la fecha móvil buscada
Celda Y: Aquí se introduce manualmente la cantidad de días hábiles existentes antes de la fecha móvil buscada
Celdas Z y AA: Muestra la cantidad de días hábiles existentes en el mes de la fecha móvil
Celdas AB y AC: Arrojan la fecha móvil exacta conforme al año y los datos introducidos en las Celdas X y Y
Haciendo un análisis de los datos infiero que el problema radica en que el ejemplo del tutorial está configurado para arrojar resultados correctos solamente para la semana que contenga el tercer viernes de un mes determinado de allí que al buscar otra fecha móvil los datos que se introducen en las Celdas X y Y no sean no sean los que realmente deberían para que se puedan alcanzar las fechas exactas en las Celdas AB y AC, sin embargo hay fechas que aun introduciendo datos correctos en las Celdas X y Y o aproximándolos lo más posible no es posible obtener resultados correctos.

Por jues, · publicado el martes a las 15:013 días
Fechas Móviles

Hola,
Sería interesante que explicaras con detalle qué es lo que falla de tu archivo, por qué, y qué es lo que buscas obtener.
Hasta la columna W todo parece entendible, pero habría que ver cómo los datos X:Y introducidos a voluntad (supongo), afectan al comportamiento (o no) de los siguientes cálculos. Igual que las columnas AB:AC, qué resultados pretenden plasmar.
Saludos,

Por Victor7, · publicado el martes a las 06:554 días

No hay usuarios registrado para ver esta página.

Conéctate a Ayuda Excel

Los "N..." mejores (formulario)

Featured Replies

Archivado

Archivos

Agenda Calendario Vintage

Cómo conservar la función AHORA()

Agenda v01

Gráficos de aranceles con colores difusos

Cómo crear hipervínculos inteligentes con fórmulas

Estadísticas de descargas

Mensajes

Fechas Móviles

Fechas Móviles

Fechas Móviles

Fechas Móviles

Fechas Móviles

Visualizado recientemente 0

Account

Navigation

Buscar

Configure browser push notifications

Chrome (Android)

Chrome (Desktop)

Safari (iOS 16.4+)

Safari (macOS)

Edge (Android)

Edge (Desktop)

Firefox (Android)

Firefox (Desktop)