Saltar al contenido

Los "N..." mejores (formulario)

publicado

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.zipFetching info...

Featured Replies

publicado

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

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
  • 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

  Cita
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.zipFetching info...

publicado

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
  • 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 _.zipFetching info...

publicado

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
  • Autor

Re: Los "n" mejores (formulario)

  "himself dijo:
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

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
  • Autor
  "Ricardo Palacios dijo:
te adjunto el archivo, para mas detalles gracias
  "Gerson Pineda dijo:
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

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

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

Archivado

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

Ir al listado de temas