Criterio alfanumerico para filtro

28/08/2006 - 18:36 por Ivan | Informe spam
Hola a todos de nuevo.

Tengo un formulario con dos combobox y un listbox que funcionan de la
siguiente manera:

1.- en el 1er combo (cmbElegir) se cargan, al abrirse el formulario,
los titulos de campo (26 en total) de una hoja de excel.

2.-en el 2º combo (cmbCriterio) se cargan las entradas del campo
seleccionado en el 1ª.

3.- en el listbox (lstSeleccionar-> multiselect de 4 columnas) se
cargan, segun se va tecleando en el 2º combo, las columnas A, B, C y D
de todas las coincidencias de lo tecleado. Se utiliza Autofiltro y como
criterio1 lo introducido en el 2º combo y un comodin (*).

Pej: si elijo el campo "Nombre" en el 1er combo y en el hay estas
entradas:

Pepe
Juan
Pablo

-> al teclear "p" en el 2º combo aparecera en el listbox lo que haya
en las columnas A,B,C y D de los registros Pepe y Pablo -> si a
continuacion tecleo la "a" ( o sea "pa" en total) apareceran solo las
correspondientes a Pablo.

Todo funciona perfectamente excepto cuando los valores del campo
elegido como criterio comienzan por un digito. He hecho numerosas
pruebas intentando convertir los 'valores' a 'valor' y a la inversa,
pero no logro que me reconozca? los numeros como criterio de filtro y
me cargue las columnas correspondientes en el listbox. En el 2º combo
si se carga el campo correspondiente. La mayoria de los campos son de
texto, pero hay varios de fecha, y fundamentalmente el 1ª (columnaA)
es un nº unico que se corresponde con el nº de ficha y que actua como
campo clave .(por cierto, la propiedad matchentry esta establecida a
none.)

No se si me he explicado, pero en cualquier caso aqui va el codigo del
2º combo, en el que creo que esta el problema. En el , como
comentario, esta uno de los intentos de conversion a valor del criterio
de filtrado.

Private Sub cmbCriterio_Change()
Dim Patron As String
If cmbCriterio = "" Then
lstSeleccionar.Clear: txtNroLibros = 0
Exit Sub: End If
Application.ScreenUpdating = False
' If IsNumeric(Val(cmbCriterio)) Then
' Patron = Val(cmbCriterio)
' Else
Patron = cmbCriterio
' End If
tiempo = Timer * 1000
With lstSeleccionar
.Clear
With Worksheets("Oculta")
.UsedRange.EntireRow.Delete
With Worksheets(HojaBusqueda)
If .AutoFilterMode Then .AutoFilterMode = False
.UsedRange.AutoFilter
If .AutoFilterMode Then _
.Range("a1").CurrentRegion.AutoFilter _
Field:=cmbElegir.ListIndex + 1, _
Criteria1:=Patron & "*"
With .AutoFilter.Range
If .Rows.Count > 1 Then
On Error Resume Next
.SpecialCells(xlCellTypeVisible) _
.Copy Worksheets("Oculta").Range("a1")
On Error GoTo 0
Else
On Error Resume Next
.AutoFilterMode = False
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
End If
End With
.AutoFilterMode = False
End With
If .Range("a2") <> "" Then
lstSeleccionar.List = .Range("a2:d" & _
.[a1].End(xlDown).Row).Value
Else
txtNroLibros = 0
End If
End With
lblTiempoCriterio.Caption = "Tarda " & Timer * 1000 - tiempo & "
m/s"
txtNroLibros = .ListCount
End With
Application.ScreenUpdating = True
End Sub

Si me podis echar una mano os lo agradezco.

Un saludo y hasta pronto
Ivan

PD: el codigo esta logrado gracias a la ayuda de este foro, y ya he
realizado varias consultas sobre el referentes a otros puntos, pero
siempre acaba por surgir un nuevo contratiempo. En cualquier caso mucha
gracias por lo conseguido hasta la fecha.

Preguntas similare

Leer las respuestas

Search Busqueda sugerida