Saltar al contenido

Filtrar una columna usando "Listbox"


Recommended Posts

publicado

Hola amigos,

Tengo la siguiente Macro que permite seleccionar varios archivos de texto y copiarlos dentro de una sola hoja de Excel a la cual me gustaria hacerle algunas mejoras, he estado investigando en el foro pero por mas que modifico el codigo, no me queda como verdaderamente la quiero.

El codigo (1):

Me gustaria que al ejecutar la Macro, se insertara una columa nueva ("A") a la izquierda y pusiera el nombre del archivo que se esta ingresando (el nombre del archivo se va a repetir en cada renglon del cual este archivo pertenece), esto es para poder despues filtrar y poder seleccionar uno o varios archivos y solo ver los datos de estos).

Actualmente lo que hace es poner el nombre del archivo en un renglon arriba de donde empieza cada bloque de archivos.


Sub ProcesarArchivosTexto()Dim Archivos As VariantDim fila As Long
Archivos = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Please select the .txt files", , True)If IsArray(Archivos) = True ThenWorkbooks.AddFor x = 1 To UBound(Archivos)ProcesarArchivo Archivos(x)NextMsgBox "*** " & UBound(Archivos) & " file(s) have been processed! ***"Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.CloseElseMsgBox "*** No file(s) have been selected. Process has been canceled. ***"End IfEnd Sub

Private Sub ProcesarArchivo(Archivo As Variant)celda = Cells(100000, 1).End(xlUp).Offset(1).RowCells(celda, 1) = Mid(Archivo, Len(Archivo) - 16, 13)celda = celda + 1
With ActiveSheet.QueryTables.Add(Connection:= _"TEXT;" & Archivo, Destination:=Cells(celda, 1)).FieldNames = True.RowNumbers = False.FillAdjacentFormulas = False.PreserveFormatting = True.RefreshOnFileOpen = False.RefreshStyle = xlInsertDeleteCells.SavePassword = False.SaveData = True.AdjustColumnWidth = True.RefreshPeriod = 0.TextFilePromptOnRefresh = False.TextFilePlatform = 65001.TextFileStartRow = 1.TextFileParseType = xlDelimited.TextFileTextQualifier = xlTextQualifierDoubleQuote.TextFileConsecutiveDelimiter = False.TextFileTabDelimiter = False.TextFileSemicolonDelimiter = False.TextFileCommaDelimiter = False.TextFileSpaceDelimiter = False.TextFileOtherDelimiter = "|".TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1).TextFileTrailingMinusNumbers = True.Refresh BackgroundQuery:=False With Application For fila = 1 To 1 If Cells(fila, 1).Value = "" Then Rows(fila).Delete End If Next fila End With 'ActiveSheet.Cells.RemoveDuplicates Columns:=1 End WithEnd Sub
[/PHP]

El codigo (2): Funciona casi igual que el (1) solo que aqui ya no se repiten los encabezados y tampoco pone el nombre del archivo en un renglon extra. Lo que me gustaria agregar aqui es que por medio de un "Listbox" me permita filtrar la columna "DD" y seleccionar una, dos o las tres opciones disponibles. (Eg. "AMS", "APJ", "EMEA"). * Siempre van a ser las mismas opciones en esa columna, yo actualmente tengo asignado un Boton para cada codigo, y me gustaria que desde un inicio antes de seleccionar el Boton "2" yo pudiera elegir cualquiera de las 3 opciones arriba mencionadas para que solo me aparezcan datos de esas opciones, por lo que pensé que seria ideal por medio de un "Listbox".

[PHP]

Sub ProcesarArchivoSinEncabezado()Dim Archivos As VariantDim fila As Long
Archivos = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Please select the .txt files", , True)If IsArray(Archivos) = True ThenWorkbooks.AddFor x = 1 To UBound(Archivos)ProcesarArchivo Archivos(x)NextMsgBox "*** " & UBound(Archivos) & " file(s) have been processed! ***"Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.CloseElseMsgBox "*** No file(s) have been selected. Process has been canceled. ***"End IfEnd Sub

Private Sub ProcesarArchivo(Archivo As Variant)celda = Cells(100000, 1).End(xlUp).Offset(0).Rowcelda = celda + 1
With ActiveSheet.QueryTables.Add(Connection:= _"TEXT;" & Archivo, Destination:=Cells(celda, 1)).FieldNames = True.RowNumbers = False.FillAdjacentFormulas = False.PreserveFormatting = True.RefreshOnFileOpen = False.RefreshStyle = xlInsertDeleteCells.SavePassword = False.SaveData = True.AdjustColumnWidth = True.RefreshPeriod = 0.TextFilePromptOnRefresh = False.TextFilePlatform = 65001.TextFileStartRow = 1.TextFileParseType = xlDelimited.TextFileTextQualifier = xlTextQualifierDoubleQuote.TextFileConsecutiveDelimiter = False.TextFileTabDelimiter = False.TextFileSemicolonDelimiter = False.TextFileCommaDelimiter = False.TextFileSpaceDelimiter = False.TextFileOtherDelimiter = "|".TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1).TextFileTrailingMinusNumbers = True.Refresh BackgroundQuery:=False
With Application For fila = 1 To 1 If Cells(fila, 1).Value = "" Then Rows(fila).Delete End If Next fila End With ActiveSheet.Cells.RemoveDuplicates Columns:=1 Worksheets("Sheet1").EnableAutoFilter = True With ActiveWindow .SplitColumn = 0 .SplitRow = 1 .FreezePanes = True End With Rows("1:1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5296274 .TintAndShade = 0 .PatternTintAndShade = 0 End With Rows("1:1").Select Selection.AutoFilter Selection.Font.Bold = True End WithEnd Sub
[/PHP]

Muchisimas gracias por toda su ayuda y tomarse el tiempo de leer y tratar de resolver esta duda.

Archivado

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

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.