Usar Filtros Avanzados desde controles en un UserForm para obtener determinados registros en una hoja y trasladarlos a un control ListBox en el mismo UserForm
Contaduria
Como estan? Espero que bien. Tengo el siguiente problema para resolver.
Supongamos que en un libro exista una hoja llamada "Datos", que tenga la
siguiente tabla:
Nº Op. Centro de Costo Cuenta Importe
1 Administración Mantenimiento $ 1.000
2 Administración Mantenimiento $ 2.000
3 Depósito Fletes $ 1.000
4 Sucursal Fletes $ 1.000
5 Administración Impuestos $ 1.500
6 Depósito Fletes $ 3.000
7 Sucursal Fletes $ 1.000
8 Depósito Fletes $ 1.500
9 Depósito Mantenimiento $ 2.000
Supongamos también que tengo un UserForm en el cual tengo dos controles del
tipo ComboBox:
1) El ComboBox 1 tiene los items correspondientes a los Centros de Costo, en
el ejemplo: Administración, Depósito, Sucursal y Todos.
2) El ComboBox 2 tiene los items correspondientes a las Cuentas, en el
ejemplo: Mantenimiento, Fletes, Impuestos y Todos.
En el UserForm también existe un control del tipo ListBox. Lo que yo
necesito es que al seleccionar un item del Combo 1 y un item del Combo 2 se
carguen todos los registros que cumplan las condiciones al ListBox y además
el código agregue una línea más al final con la suma de todos los importes.
Ejemplo 1:
Selecciono "Administración" en el ComboBox 1
Selecciono "Mantenimiento" en el ComboBox 2
Resultado: El ListBox muestra:
Nº Op. Centro de Costo Cuenta Importe
1 Administración Mantenimiento $ 1.000
2 Administración Mantenimiento $ 2.000
Total $
3.000
Ejemplo 2:
Selecciono "Depósito" en el ComboBox 1
Selecciono "Fletes" en el ComboBox 2
Resultado: El ListBox muestra:
Nº Op. Centro de Costo Cuenta Importe
3 Depósito Fletes $ 1.000
6 Depósito Fletes $ 3.000
8 Depósito Fletes $ 1.500
Total $
5.500
Ejemplo 3:
Selecciono "Todos" en el ComboBox 1
Selecciono "Fletes" en el ComboBox 2
Resultado: El ListBox muestra:
Nº Op. Centro de Costo Cuenta Importe
3 Depósito Fletes $ 1.000
4 Sucursal Fletes $ 1.000
6 Depósito Fletes $ 3.000
7 Sucursal Fletes $ 1.000
8 Depósito Fletes $ 1.500
Total $
7.500
Ejemplo 4:
Selecciono "Administración" en el ComboBox 1
Selecciono "Todos" en el ComboBox 2
Resultado: El ListBox muestra:
Nº Op. Centro de Costo Cuenta Importe
1 Administración Mantenimiento $ 1.000
2 Administración Mantenimiento $ 2.000
5 Administración Impuestos $ 1.500
Total $
4.500
Sospecho que debe poder hacerse con los filtros avanzados (AdvancedFilter),
pero no se como manejarlos. La unica manera que intenté para resolverlo es
haciendo varios bucles del tipo For - Next en donde el código va comparando
celda por celda si cumple o no con las condiciones, pero la verdad que
funciona muy lento y queda un código excesivamente complejo. Estoy seguro
que con el AdvancedFilter se debe poder hacer mejor. Ayuda por favor!
Espero haya sido claro en mi exposición. Cualquier consulta estoy a su
disposición.
Saludos y desde ya muchas gracias.
Mariano
alejo
Amigo Mariano,
Yo no soy un duro en programacion de Macros o Exce VBa, pero me doy
cuenta que eso lo puedes hacer simplemente con una tabla
dinámica . ..
Cual es el problema ? A veces no hay que complicarse tanto para llegar
a un fin. La tabla dinamica te suma en la parte de abajo según el
criterio, además te da la opcion de incluso filtrar datos por los dos
criterios que quieres utilizar .. .
Contaduria
Gracias por la ayuda. Pero en una tabla dinámica no me sirve, porque
necesito que la información sea configurada y mostrada desde controles en un
UserForm, ya que esto es parte de un sistema que en realidad es más grande y
tiene otras cosas.
Saludos.
Mariano
--
Insumos
Mar del Plata
(0223) 475-5511
Open Sports... elegí deporte!
www.opensports.com.ar
ins...@openmdq.com.ar
"alejo" <alejoq...@gmail.com> escribió en el mensaje
news:889589a6-7737-4168...@k37g2000hsf.googlegroups.com...
Ivan
cuanto tiempo (de hecho creo recordar que hace ya bastante tuviste
alguna consulta [muy] similar, aunque lo mismo mi neurona empieza
[sigue :-)] a fallarme)
> sea configurada y mostrada desde controles en un UserForm,
seguro que es muy simplificable, pero si quieres haz alguna prueba con
el codigo que te pongo a continuacion:
no esta comentado, excepto la descripcion de los parametros, pero en
definitiva lo que hace es =>
a) cargar en un listbox (1er parametro)
b) el contenido de una lista (la 1ª celda<Range> de los titulos como
2º parametro)
c) tras filtrarla y pegar el resultado en una hoja (3er parametro =
nombre de esta hoja <String>)
d) con las coincidencias encontradas en las columnas pasadas en el 4º
parametro <Variant/Matriz>
e) de los respectivos criterios pasados en el 5º parametro <Variant/
Matriz>
Puedes poner tantos criterios/campos como gustes, pero tal y como
esta diseñado el codigo, deben de ser de tipo texto,
y por supuesto, ordenados igual en el 4º y 5º parametros
[y ... no tiene control de errores]
OJO a los posibles saltos de linea en el codigo
' Parametros:
'
' .-> lstbox = el listbox
' .-> celdaini = 1ª celda de la lista, incluida la fila
' de titulos. Pej: Range("A1")
' .-> hojaDestino = nombre de una hoja, que puede estar oculta
' y que podrias crear al abrir el form y
' eliminarla al cerrarlo, y que estaria
' destinada a los registros filtrados
' .-> columnas = matriz col los numeros de las columnas en
' donde se van a comparar los criterios
' .-> datos = matriz con el contenido de los combos y en
' el mismo orden de las columnas.
'
Private Sub cargarListBox( _
ByRef lstBox As MSForms.ListBox, _
ByVal celdaIni As Range, _
ByVal hojaDestino As String, _
ByRef columnas As Variant, _
ByRef datos As Variant)
Dim rngLista As Range, rngDestino As Range, _
rngCriterio As Range
Set rngLista = celdaIni.CurrentRegion
With rngLista.Parent
Set rngCriterio = .Range(.Cells(1, _
rngLista.Columns.Count + 3), _
.Cells(2, rngLista.Columns.Count + 3))
With .Parent.Worksheets(hojaDestino)
Set rngDestino = .Range(.Cells(1, 1), _
.Cells(1, rngLista.Columns.Count))
End With
End With
rngDestino.CurrentRegion.Clear
rngCriterio.CurrentRegion.Clear
Dim n As Integer, criterio As String
criterio = ""
For n = o To UBound(columnas)
If datos(n) <> "" Then _
criterio = criterio & Cells(2, columnas(n)) _
.Address(0, 0) & "=""" & datos(n) & ""","
Next
ListBox1.RowSource = ""
If criterio <> "" Then criterio = _
"=and(" & Left(criterio, Len(criterio) - 1) & ")"
rngCriterio.Cells(2, 1).Value = criterio
rngLista.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rngCriterio, _
CopyToRange:=rngDestino, _
Unique:=False
With lstBox
.Clear
.ColumnCount = rngDestino.Columns.Count
.ColumnHeads = True
.RowSource = rngDestino.Parent.Name & "!" & _
rngDestino.CurrentRegion.Offset(1).Resize( _
rngDestino.CurrentRegion.Rows.Count - 1, _
rngDestino.Columns.Count).Address(0, 0)
End With
rngCriterio.Clear
Set rngCriterio = Nothing
Set rngDestino = Nothing
Set rngLista = Nothing
End Sub
' y esta seria una aplicacion en tu ejemplo,
' con los controles llamados 'ListBox1', 'ComboBox1' y 2,
' la hoja de la lista "Hoja1" y como nombre de la hoja
' de destino "oculta".
' NOTA: en todos los combos iria el mismo codigo
'
Private Sub ComboBox1_Change()
Dim col As Variant, dts As Variant
col = Array(2, 3)
dts = Array(ComboBox1.Text, ComboBox2.Text)
cargarListBox ListBox1, Worksheets("Hoja1").[a1], _
"oculta", col, dts
End Sub
'------------------------------------------------------------------------------
bueno, al menos parece funcionar
un saludo
Ivan
' -----------------------------codigo-------------------------------
Ivan
que he enviado)
en dicho mensaje cambia el codigo por este otro (las explicaciones y
forma de aplicacion son las mismas). Es practicamente igual pero se me
habia quedado una cosilla por ahi .... [ojo: lo mismo salta alguna
otra :-D] . Para no liarla lo vuelvo a poner entero retocado.
Private Sub cargarListBox( _
ByRef lstBox As MSForms.ListBox, _
ByVal celdaIni As Range, _
ByVal hojaDestino As String, _
ByRef columnas As Variant, _
ByRef datos As Variant)
Dim rngLista As Range, rngDestino As Range, _
rngCriterio As Range
Set rngLista = celdaIni.CurrentRegion
With rngLista.Parent
Set rngCriterio = .Range(.Cells(1, _
rngLista.Columns.Count + 3), _
.Cells(2, rngLista.Columns.Count + 3))
With .Parent.Worksheets(hojaDestino)
Set rngDestino = .Range(.Cells(1, 1), _
.Cells(1, rngLista.Columns.Count))
End With
End With
rngDestino.CurrentRegion.Columns.Clear
rngCriterio.CurrentRegion.Clear
Dim n As Integer, criterio As String
criterio = ""
For n = o To UBound(columnas)
If datos(n) <> "" Then _
criterio = criterio & Cells(2, columnas(n)) _
.Address(0, 0) & "=""" & datos(n) & ""","
Next
If criterio <> "" Then criterio = _
"=and(" & Left(criterio, Len(criterio) - 1) & ")"
rngCriterio.Cells(2, 1).Value = criterio
rngLista.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rngCriterio, _
CopyToRange:=rngDestino, _
Unique:=False
With lstBox
.RowSource = ""
.ColumnCount = rngDestino.Columns.Count
.ColumnHeads = True
Dim fila As Long
fila = rngDestino.CurrentRegion.Rows.Count - 1
If fila < 1 Then fila = 1
.RowSource = rngDestino.Parent.Name & "!" & _
rngDestino.CurrentRegion.Offset(1).Resize( _
fila, rngDestino.Columns.Count).Address(0, 0)
End With
rngCriterio.Clear
Set rngCriterio = Nothing
Set rngDestino = Nothing
Set rngLista = Nothing
End Sub
un saludo
Ivan
Contaduria
Muchisimas gracias por tu ayuda. Tu solución es lo que buscaba y funciona
perfectamente.
Y con respecto a tu pregunta, la respuesta es si, hace tiempo me habías
pasado una solución de filtros avanzados, pero referida a datos ingresados
en determinadas celdas en una hoja. Quise adaptarlo a controles en un
UserForm pero sin éxito. Pero yo sabía que la cuestión podía solucionarse
con los filtros avanzados, solo se requeria el conocimiento necesario que
vos amablemente has compartido conmigo.
Muchas gracias otra vez por solucionar mis problemas.
Mariano
--
Insumos
Mar del Plata
(0223) 475-5511
Open Sports... elegí deporte!
www.opensports.com.ar
ins...@openmdq.com.ar
"Ivan" <lom...@teleline.es> escribió en el mensaje
news:9eb89b29-06e8-492c...@i76g2000hsf.googlegroups.com...
Ivan
creo que se me paso lo del total. Para ello [creo que] podrias
realizar la suma tras el filtrado y antes de la carga del listbox (no
lo he probado, pero supongo que el rowsource incluiria la fila sin
problemas) con algo asi (de memoria)=>
dim f as long
f = rDestino.currentregion.rows.count
with rDestino.parent
.cells(f + 1, 1) = "Total"
.cells(f + 2, 1) = application.sum(.rDestino.row + 1, f -
rdestino.row)
end with
aunque yo particularmente creo que preferiria 'adosar' un label (pej)
en la parte inferior (pej) del listbox, a modo del cuadro de total de
una factura
creo que te valdria tambien Sum
un saludo
Ivan
PD:
>>.... hace tiempo .. una solución de filtros avanzados, pero referida a ...
bueno, al menos todavia no chocheo. Me sonaban campanas :-)))
Ivan
sumale 1 =>
..Cells(f + 2, 1) = Application.Sum( _
.Range(.Cells(rDestino.Row + 1, 4), _
.Cells(f - rDestino.Row + 1, 4)))
Contaduria
Gracias por completar la solución con la suma. Con toda la ayuda que me has
dado en esta y otras ocasiones no puedo menos que invitarte un trago o una
cerveza... y a Hector Miguel también por supuesto.
Saludos!
Mariano
--
Insumos
Mar del Plata
(0223) 475-5511
Open Sports... elegí deporte!
www.opensports.com.ar
ins...@openmdq.com.ar
"Ivan" <lom...@teleline.es> escribió en el mensaje
news:b1778759-0bbd-4a21...@i76g2000hsf.googlegroups.com...
Ivan
> invitarte un trago o una
> cerveza...
nunca se sabe, a veces las distancias se 'esfuman'. [aunque habria que
consultarle a mi higado :-DD]
>y a Hector Miguel también por supuesto.
creo que Hector [si que] tendria para cogerse unas cuantas cogorzas
por esta via :-)
un saludo
Ivan
Héctor Miguel
por la parte que "me toca" (aunque no he tenido que ver en este hilo)...
muy agradecido... muy agradecido... y muy agradecido !!! :D
(pero sientanse "liberados", ya que aunque las distancias se "esfumen", soy abstemio) :))
saludos,
hector.
Ivan
> por la parte que "me toca" (aunque no he tenido que ver en este hilo)...
pues por la que "me toca" a mi, creo que si que has tenido MUCHO [casi
todo] que ver (aun mas en lo que a los FFAA <y no me refiero a la
'soldadesca' :-D> se refiere). Thanks :-))
un saludo
Ivan
PD: Mariano, si quieres cambia en la asignacion al rango del criterio
el uso de 'Value' por el de 'Formula', que era lo que en realidad
queria poner. Aunque parece que Value tambien hace el apaño, quizas
pueda haber algo que al menos yo no controle y de problemas. Si no me
equivoco lo 'apropiado' es=>
rCriterio.Cells(2,1).Formula = .....
tambien se me fue la 'plla' en el rango del primer mensaje sobre la
suma, pero en el 2º esta +/- corregido y supongo que ya te habras dado
cuenta
Contaduria
Modifiqué .Formula por .Value y funciona igual de bien. Y con respecto a la
suma puse un Label en el cual con cada evento Change de cada Combo "carga"
la sumatoria de los importes a su propiedad .Caption, asi:
Dim Suma as Double
Suma = Application.WorksheetFunction.Sum(Worksheets("Reportes") _
.Range("C2:C" & Worksheets("Reportes").[C65536].End(xlUp).Row))
lblImporte.Caption = Format(Suma, "#,#00.00")
Y con respecto a la invitación, no necesariamente tiene que ser una cerveza
o trago, sino algún jugo de frutas, gaseosa, o una cena o almuerzo. Como
sea, si alguna vez vienen a Mar del Plata, Argentina, serán bienvenidos por
su servidor que tan amablemente han ayudado tantas veces.
Muchas Gracias y Saludos.
Mariano
--
Insumos
Mar del Plata
(0223) 475-5511
Open Sports... elegí deporte!
www.opensports.com.ar
ins...@openmdq.com.ar
"Ivan" <lom...@teleline.es> escribió en el mensaje
news:77e45522-2749-45ca...@x41g2000hsb.googlegroups.com...
luis.enriq...@gmail.com
Tengo una base de datos de pedidos de clientes, los cuales despues de tratar la información cada item de cada pedido tiene una etiqueta, "ORG" para el pedido original, "ELM" para pedidos sin existencia, "AGX" para items sugeridos pendientes y "SUS" para items sustituidos. Lo que necesito es que a la hora de desplegar el cliente con un combobox le doy click y me debe salir la lista solo con item con etiqueta "ORG" y "SUS"; los item con "ELM" y "AGX" no deben salir en el listbox. Pero a la hora de buscar no me despliega nada y si quito un criterio de las etiquetas ya sea "ORG" y "SUS", si me despliega la información. Aqui basicamente son 3 criterios de busqueda.
1. Busqueda por cliente (ComboBox)
2. Busqueda por etiqueta ("ORG")
3. Busqueda por etiqueta ("SUS")
Tengo el código que a continuación les comparto:
Private Sub CSearch_Click()
'MODULO CONFIRMADO
If Me.OpConfirmado.Value = True Then
Sheets("Concentrado").Select
On Error GoTo ErrorCC
If Me.CCustomerBox.Value = "" Then Exit Sub
Me.CListBox.Clear
Filas = Range("Concentrado").CurrentRegion.Rows.Count + 1
For i = 3 To Filas
If LCase(Cells(i, 5).Value) = LCase(Me.CCustomerBox.Value) _
And LCase(Cells(i, 43).Value) = LCase("ORG") _
And LCase(Cells(i, 43).Value) = LCase("SUS") Then
Me.CListBox.AddItem Cells(i, 5)
Me.CListBox.List(Me.CListBox.ListCount - 1, 1) = Cells(i, 6)
Me.CListBox.List(Me.CListBox.ListCount - 1, 3) = Cells(i, 8)
Me.CListBox.List(Me.CListBox.ListCount - 1, 4) = Cells(i, 39)
Me.CListBox.List(Me.CListBox.ListCount - 1, 5) = FormatCurrency(Cells(i, 10))
Me.CListBox.List(Me.CListBox.ListCount - 1, 6) = Cells(i, 11)
Me.CListBox.List(Me.CListBox.ListCount - 1, 7) = FormatCurrency(Cells(i, 40))
Me.CListBox.List(Me.CListBox.ListCount - 1, 8) = Cells(i, 43)
End If
Next i
Exit Sub
ErrorCC:
MsgBox "No Se Encuentra Cliente", vbExclamation, "FestyNav"
End If
End Sub
Agradezco de verdad su apoyo. Saludos.
Pablo Arola
Yo lo resolví de la siguiente manera:
Hice un formulario con dos ComboBox
Un botón de comando
Un ListBox para colocar el resultado del filtro
Y un Label para que arroje los totales
Cada uno de los combo permite seleccionar una de las categorías: Centro de Costo y Cuenta
Y en sus correspondientes eventos Change les puse estos respectivos códigos:
(Con este código, al seleccionar un ítem, lo seleccionado se colocará en la celda correspondiente del área de axtracción.)
Private Sub cmbcentroCosto_Change()
Select Case cmbcentroCosto.Value
Case "Todos"
[Centro_de_Costo].Value = ""
Case Else
[Centro_de_Costo].Value = cmbcentroCosto.Value
End Select
End Sub
Private Sub cmbCuenta_Change()
Select Case cmbCuenta.Value
Case "Todos"
[Cuenta].ClearContents
Case Else
[Cuenta].Value = cmbCuenta.Value
End Select
End Sub
Además, generé una área de extracción de filtro avanzado con los mismos encabezados que tiene la base de datos.
Es decir : Nº Op. Centro de Costo Cuenta Importe
Al botón de comando le generé el siguiente código:
Private Sub btnResultados_Click()
Dim BaseDatos As Range
Application.CutCopyMode = False
uf = [A1].End(xlDown).Row
Set BaseDatos = Range(Cells(1, 1), Cells(uf, 4))
BaseDatos.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("Criteria"), Unique:=False
Call Detalle
End Sub
La llamada al procedimiento Detalle es lo siguiente:
Sub Detalle()
Dim matrizExtracto() As String
ReDim matrizExtracto(uf, 4)
Dim col As Long
Dim fil As Long
Dim rng As Range
Dim celda As Range
Set rng = Range([A2], [A1].End(xlDown))
Set rng = rng.SpecialCells(xlCellTypeVisible)
For Each celda In rng.Cells
Me.lstExtracto.AddItem celda.Value & " " & celda.Offset(0, 1).Value _
& " " & celda.Offset(0, 2).Value _
& " " & celda.Offset(0, 3).Value
Next celda
Me.lblTotal = [Total].Value
Me funcionó a la perfección.
Me gustaría adjuntar el archivo...pero me parece que es imposible por este medio.
Bueno, espero que te sirve.
PABLO