Como buscar palabra en archivo de Word de un directorio si encuentra hace link





Se han presentado varios ejemplos que vinculan Excel con Word, como copiar una tabla vinculada de Excel a Word, como copiar un gráfico de Excel a Word o como crear cartas en Word desde Excel entre otras macros.

Antes de continuar con el desarrollo del presente post, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail, trabajando con filas, celdas, columnas, rangos y muchos ejemplos más.










    

Aporta por favor para sostener el sitio si está dentro de tus posibilidades, desde ya muchas gracias, desde el link del final del post se puede descargar el ejemplo de macro, cada usuario puede adaptarlo a sus necesidades, la codificación está abierta y es de libre, se brinda en forma gratuita.

El ejemplo denominado como buscar una palabra en un Archivo de Word creando link al fichero, permite recorrer un directorio buscar en cada archivo Word de ese directorio una palabra específica, si encuentra dicha palabra hace un link al fichero de Word.

Se recomienda descargar el fichero comprimido descomprimir en cualquier parte de la PC, contiene un fichero con la macro y un directorio con archivos Word de ejemplo que usa la macro para realizar el procedimiento.

En un primer momento al presionar el botón que está en la hoja de Word para ejecutar la macro, se muestra un explorador de archivos que permite seleccionar la carpeta que contiene los archivos donde buscará la macro, seleccionado el directorio, la macro empieza un bucle recorriendo desde el primer al último fichero de Word.

En el StatusBar se va mostrando el número de archivo procesado del total, la macro toma el primer fichero de Word lo abre, busca la palabra ingresada en la celda B1, la búsqueda se realiza en todo el archivo de Word, si la palabra es encontrada hace un link al archivo.

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Conectar Excel con Word crear fichero Word e insertar texto


Conectar Excel con Word manipular Word desde Excel y modificar plantilla

Como crear una factura con Word y descontar Stock al facturar

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

La búsqueda de la palabra en el fichero de word se efectúa con el siguiente código:

Set objWord = CreateObject("Word.Application")
objWord.DisplayAlerts = wdAlertsNone
objWord.Visible = True
Set wdDoc = objWord.Documents.Open(ruta)
ts = Range("B1")
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
If objWord.Selection.Find.Found = True Then
a.Range("A" & uf) = ruta
texhipv = a.Range("A" & uf)
a.Hyperlinks.Add Anchor:=a.Range("A" & uf), Address:=ruta, TextToDisplay:=texhipv
uf = uf + 1
NunFich = NunFich + 1
End If
wdDoc.Close
objWord.Quit


En este código primero se crea un objeto con la aplicación Word abriendo el archivo, en la variable "ts" se guarda el dato a buscar que está en la celda B1 luego se inicia un procedo de búsqueda desde la primera hasta la última palabra de Word, en caso de encontrar la palabra requerida se procede a crear un link, hipertexto, hipervinculo o como le prefieran llamar al archivo de Word y el mismo se copia en la columna A y fila correspondiente, luego desde este link se puede abrir desde Excel el archivo de Word.

Código que se inserta en un módulo

Sub BuscarEnWord()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path1 As String, ruta As String, texhipv As String
Set a = Sheets(ActiveSheet.Name)
a.Range("A2:A1000").Clear
uf = a.Range("A" & Rows.Count).End(xlUp).Row
If uf < 2 Then uf = 2
'path1 = ActiveWorkbook.Path & "\324 PruebaHyper"
path1 = CreateObject("shell.application").browseforfolder(0, "Seleccione Carpeta", 0).Items.Item.Path
 If path1 = "" Then
 MsgBox "No ha seleccionado directorio carpeta Excel, seleccione directorio .", , "AVISO"
 Exit Sub
 End If
NunFich = 0
x = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set carpeta = fso.getfolder(path1)
Set ficheros = carpeta.Files
canfic = carpeta.Files.Count
For Each ficheros In ficheros
b = ficheros.Name
Application.StatusBar = "Procensando " & x & " de " & canfic & " Archivos en el Directorio"
ruta = path1 & "\" & b
Set objWord = CreateObject("Word.Application")
objWord.DisplayAlerts = wdAlertsNone
objWord.Visible = True
Set wdDoc = objWord.Documents.Open(ruta)
ts = Range("B1")
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
If objWord.Selection.Find.Found = True Then
a.Range("A" & uf) = ruta
texhipv = a.Range("A" & uf)
a.Hyperlinks.Add Anchor:=a.Range("A" & uf), Address:=ruta, TextToDisplay:=texhipv
uf = uf + 1
NunFich = NunFich + 1
End If
wdDoc.Close
objWord.Quit
x = x + 1
Next ficheros
MsgBox ("Se encontraron " & NunFich & " ficheros en la carpteta seleccionada"), vbInformation, "AVISO"
Application.StatusBar = Clear
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Como cargar listbox con datos provenientes de varias hojas





Macro que permite cargar listbox con datos provenientes de varias hojas de Excel, pregunta que mi hicieron un suscriptor de nuestro canal de you tube, es posible que también sea útil otros post relacionados, como aumentar al máximo la velocidad de búsqueda o como escribir en el mismo listbox el total de registros o importes, aquí encuentras un montón de ejemplos con listbox.

Antes de continuar con el desarrollo del presentw post, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mailconectar Excel con Access y muchos ejemplos más.










    

Por favor considera la posibiliad de aportar para sostener el sitio, desde el link del final del post se puede descargar el ejemplo de macro, cada usuario puede adaptarlo a sus necesidades, la codificación está abierta y es de libre, se brinda en forma gratuita.

El ejemplo es bastante sencillo cuando se inicia el formulario que contiene el listbox, se muestra un formulario de VBA que contiene un listbox, al mostrase el formulario se ejecuta un procedimiento que permite cargar datos de dos hojas distintas del mismo Libro de Excel.

Con el siguiente código se adiciona un item para poder escribir la cabecera de las columnas en el listbox, es decir el títulos de las columnas de la base de datos de Excel se escriben en la primera fila del listbox, se hacer con este código:

'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For ii = 0 To 2
UserForm1.ListBox1.List(0, ii) = b.Cells(1, 1)
UserForm1.ListBox1.List(0, ii) = a.Cells(1, 1)
Next ii


⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Buscar datos mientras se escribe en textbox y mostrar en hojas en hojas de Excel


Como acelerar busqueda en Listbox en Excel mientras se escribe en textbox

Como pasar varios datos datos con Enter de un Listbox multiselect a hojas de Excel

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Luego se ejecuta un código para poder cargar con el método AddItem (también se puede cargar un listbox con RowSource); los datos en el listbox que se encuentran en la hoja dos, para ello se utiliza:

fila = 2
While b.Cells(fila, 1) <> Empty
        aa = ListBox1.ListCount
        ListBox1.AddItem
        ListBox1.List(aa, 0) = b.Cells(fila, 1)
fila = fila + 1
Wend

Cargados los datos de la hoja dos, se pasa a la hoja 3 y se cargan los datos en el listbox con la siguiente codificación:

fila = 2
For aa = 1 To ListBox1.ListCount - 1
ListBox1.List(aa, 1) = a.Cells(fila, 1)
fila = fila + 1
Next aa

El resultado es lo que pueden ver en el vídeo o al ejecutar la macro en vuestra PC, por lo que sugiero descargar el archivo del ejemplo denominado como cargar listbox con datos provenientes de varias hojas de Excel,


Código que se inserta en un módulo

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set a = Sheets("Hoja3")
Set b = Sheets("Hoja2")

uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
    .ColumnCount = 2
    .ColumnWidths = "30 pt;150pt"
End With


'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For ii = 0 To 2
UserForm1.ListBox1.List(0, ii) = b.Cells(1, 1)
UserForm1.ListBox1.List(0, ii) = a.Cells(1, 1)
Next ii

fila = 2
While b.Cells(fila, 1) <> Empty
        aa = ListBox1.ListCount
        ListBox1.AddItem
        ListBox1.List(aa, 0) = b.Cells(fila, 1)
fila = fila + 1
Wend


fila = 2
For aa = 1 To ListBox1.ListCount - 1
ListBox1.List(aa, 1) = a.Cells(fila, 1)
fila = fila + 1
Next aa
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Como Renombrar Archivos Intercambiando Cadena de Caracteres en Nombre Archivo





El ejemplo de macro que se presenta muestra como renombrar archivos o ficheros intercambiando una cadena de caracteres en en nombre del fichero, es una variante de otros ejemplos que se presentaron anteriormente que, este ejemplo permite tomar destreza en el manejo de cadenas de caracteres, texto o string, si requieres saber mas al respecto visita macro que trabajo con texto o string. Recuerda que en un ejemplo anterior se expuso como renombrar el archivo y crear un link al propio archivo, esto permite hacer click en el link que está en la celda de excel y abrir un archivo con solo un click son movernos de la hoja de Excel.

Recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mailconectar Excel con Access y muchos ejemplos más.








 

Por favor considera la posibiliad de aportar para sostener el sitio, desde el link del final del post se puede descargar el ejemplo de macro, cada usuario puede adaptarlo a sus necesidades, la codificación está abierta y es de libre, se brinda en forma gratuita.

Para trabajar con el ejemplo o facilitar la comprensión del mismo, se debe descargar el archivo comprimido desde el final del link, este archivo contiene la macro y un fichero con varios archivo que la macro renombrará.

La macro en un primer momento nos da la opción para elegir la carpeta donde están los archivos a renombrar, luego se hace un bule de 1 a 10 que son los ficheros que contiene, próximamente voy a exponer una macro para contar los archivos de un directorio, suscriban desde el lado derecho de este web insertando solamente el mail para que se le mande un aviso a su casilla de correo.

Luego empieza a hacer el bucle recorriendo archivo por archivo, lo que hace la macro es leer la cadena de caracteres, establecer donde se encuentra el número que contiene el nombre de cada fichero, estableciendo la posición de este número en el nombre del fichero se extrae la cadena de texto que se encuentra delante y detrás del numero agregándolos a variables.

Los códigos siguientes son los que permiten extraer el número inserto en el nombre del fichero, luego se concatena poniendo el número extraído y cargado en la variable num; con la primer parte del nombre del archivo, cargado en la variable pp y la última parte del nombre del archivo cargado en la variable sp.

 esp2 = InStr(esp1 + 1, b, " ")
num = Mid(b, esp1 + 1, esp2 - 1 - esp1)
pp = Left(b, esp1 - 1)
sp = Mid(b, esp2 + 1)
nomnew = path1 & "\" & num & " " & pp & " " & sp


⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Buscar datos mientras se escribe en textbox y mostrar en hojas en hojas de Excel


Como acelerar busqueda en Listbox en Excel mientras se escribe en textbox

Como pasar varios datos datos con Enter de un Listbox multiselect a hojas de Excel

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Renombrado el fichero, que se logran con la siguiente linea de código:

Name nomold As nomnew

Se procede a pasar al siguiente fichero y realizar el paso descripto, hasta que se llegue al número 10 que es el último valor que debe tomar la variable del bucle.

La codificación del ejemplo se encuentra a continuación, pero es necesario descargar el fichero para poder entender con facilidad lo que se intenta explicar.


Código que se inserta en un módulo

Sub RenombraArchivo()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path1 As String, ruta As String, texhipv As String
Set a = Sheets(ActiveSheet.Name)
uf = a.Range("A" & Rows.Count).End(xlUp).Row
'path1 = ActiveWorkbook.Path & "\324 PruebaHyper"
path1 = CreateObject("shell.application").browseforfolder(0, "Seleccione Carpeta", 0).Items.Item.Path
 If path1 = "" Then
 MsgBox "No ha seleccionado directorio carpeta Excel, seleccione directorio .", , "AVISO"
 Exit Sub
 End If
NunFich = 0
num = 0
For x = 1 To 10
cadbus = x
Set fso = CreateObject("Scripting.FileSystemObject")
Set carpeta = fso.getfolder(path1)
Set ficheros = carpeta.Files
For Each ficheros In ficheros
b = ficheros.Name
nomold = path1 & "\" & b
cadbusnew = " " & cadbus & " "
esp1 = InStr(b, cadbusnew)

If esp1 > 0 Then
esp2 = InStr(esp1 + 1, b, " ")
num = Mid(b, esp1 + 1, esp2 - 1 - esp1)
pp = Left(b, esp1 - 1)
sp = Mid(b, esp2 + 1)
nomnew = path1 & "\" & num & " " & pp & " " & sp
Name nomold As nomnew
NunFich = NunFich + 1
End If
Next ficheros
Next x
Set carpeta = Nothing
Set ficheros = Nothing
MsgBox ("Se encontraron " & NunFich & " ficheros en la carpteta seleccionada"), vbInformation, "AVISO"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Buscar Datos por Varios Criterios Mientras se Escribe en Textbox y Muestra Datos en Hoja Excel





Un suscriptor de nuestro canal de YouTube solicita saber como hacer el filtrado de datos que se muestra en el ejemplo como filtrar en Excel a medida que se escribe en textbox, pero requiere se filtre por dos criterios a la vez y no separados, es decir aplicado un filtro volver a filtrar sobre esos datos ya filtrados, en base a ello este ejemplo muestra una macro que permite filtrar por varios criterios a la vez que se escribe en textbox mostrando datos en la hoja de Excel.


  

Recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mailconectar Excel con Access y muchos ejemplos más.










   

Por favor considera la posibiliad de aportar para sostener el sitio, desde el link del final del post se puede descargar el ejemplo de macro, cada usuario puede adaptarlo a sus necesidades, la codificación está abierta y es de libre, se brinda en forma gratuita.

Al descargar el ejemplo se puede observar una base de datos y en las primeras filas dos textbox donde se podrán ingresar los datos a filtrar, en este ejemplo filtra por Detalle y por Marca, al escribir en el textbox1 filtra la columna "Detalle" se observará que a medida que se escribe en el textbox simultáneamente se van filtrando los datos dependiendo de lo escrito.

De igual modo si se escribe en el textbox2 se filtran simultáneamente los datos de la columna "Marca", es decir filtra por marca del producto.

Ahora bien lo que muestra el ejemplo denominado "buscar datos por varios criterios mientras se escribe en textbox y muestra datos en hoja Excel", lo que hace es: si se escribe datos en el textbox1 filtra los datos en base a lo escrito en dicho textbox1, pero si se deja escrito en ese textbox1 el criterio por el que se requiere filtrar y se escribe en el textbox2, que filtra por "Marca" del producto, la macro vuelve a aplicar un filtro sobre los datos ya filtrados.

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Buscar datos mientras se escribe en textbox y mostrar en hojas en hojas de Excel



Como acelerar busqueda en Listbox en Excel mientras se escribe en textbox

Como pasar varios datos datos con Enter de un Listbox multiselect a hojas de Excel

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Supongamos que se tiene la base de datos que se muestra en la hoja1, del ejemplo de macro que busca mientras se escribe, requiriendo filtrar por un cierto producto, la macro ira filtrando a medida que se escribe en el textbox1 todos los productos cuyo nombre vayan coincidiendo con lo que se está escribiendo en simultaneo, filtrando todos los productos coincidentes.

Supongamos que se requieren filtrar los productos ya filtrados, pero solamente de una cierta marca, es decir se requiere aplicar un filtro sobre el filtro ya realizado, para ello se puede escribir en el textbox2 el segundo criterio de búsqueda, en este caso la "marca del producto" y la macro filtrará los productos ya filtrados, pero filtrando nuevamente los productos que solo coincidan con la marca deseada y que se escribió en el textbox2.

Con el siguiente código se determina si existe un criterio de búsqueda o dos, dependiendo de ello aplica una o otra macro, si solo se busca por un criterio ejecuta la macro:

 Call Searching

Si por el contrario se requiere volver a filtrar sobre datos ya filtrados se llama a la macro:
Call Searching11


If Sheets("Hoja1").Cells(2, 4) = Empty Then
    Sheets("Hoja1").Range("C2").Value = IIf(TextBox1.Text = "", "", "*") & TextBox1.Text & IIf(TextBox1.Text = "", "", "*")
    Call Searching
Else
    Sheets("Hoja1").Range("C2").Value = IIf(TextBox1.Text = "", "", "*") & TextBox1.Text & IIf(TextBox1.Text = "", "", "*")
    Call Searching11

La macro utilizando códigos aplica un filtro avanzado,  para ello escribe en el rango C1:D2  y luego determina este rango como criterio de filtrado, procediendo a realizar un filtro avanzado en la misma hoja, para ellos se utiliza la siguiente codificación:

Sheets("Hoja1").Range("A4:H" & uf).AdvancedFilter Action:=xlFilterInPlace,    CriteriaRange:=Range("C1:D2"), Unique:=False

A continuación se muestra la codificación completa que contiene el ejemplo, no obstante se recomienda descargarlo y observar como se comporta la macro al realizar distintas búsquedas, el ejemplo se puede adaptar a las necesidades de cada lector, su uso es libre y se proporciona en forma gratuita.

Código que se inserta en la codificación de la hoja Excel o WorkSheet

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Sheets("Hoja1").Cells(2, 4) = Empty Then
    Sheets("Hoja1").Range("C2").Value = IIf(TextBox1.Text = "", "", "*") & TextBox1.Text & IIf(TextBox1.Text = "", "", "*")
    Call Searching
Else
    Sheets("Hoja1").Range("C2").Value = IIf(TextBox1.Text = "", "", "*") & TextBox1.Text & IIf(TextBox1.Text = "", "", "*")
    Call Searching11

End If
'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub

Private Sub Searching()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    If Sheets("Hoja1").FilterMode = True Then Sheets("Hoja1").ShowAllData
    uf = Sheets("Hoja1").Range("A" & Cells.Rows.Count).End(xlUp).Row
    Sheets("Hoja1").Range("C4:C" & uf).AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=Range("C1:C2"), Unique:=False
'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub


Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Sheets("Hoja1").Cells(2, 3) = Empty Then
    Sheets("Hoja1").Range("D2").Value = IIf(TextBox2.Text = "", "", "*") & TextBox2.Text & IIf(TextBox2.Text = "", "", "*")
    Call Searching1
Else
    Sheets("Hoja1").Range("D2").Value = IIf(TextBox2.Text = "", "", "*") & TextBox2.Text & IIf(TextBox2.Text = "", "", "*")
    Call Searching11
End If
'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub

Private Sub Searching1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    If Sheets("Hoja1").FilterMode = True Then Sheets("Hoja1").ShowAllData
    uf = Sheets("Hoja1").Range("A" & Cells.Rows.Count).End(xlUp).Row
    Sheets("Hoja1").Range("D4:D" & uf).AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=Range("D1:D2"), Unique:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Private Sub Searching11()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    If Sheets("Hoja1").FilterMode = True Then Sheets("Hoja1").ShowAllData
    uf = Sheets("Hoja1").Range("A" & Cells.Rows.Count).End(xlUp).Row
    
    Sheets("Hoja1").Range("A4:H" & uf).AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=Range("C1:D2"), Unique:=False
    
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Como buscar cadena caracetes en nombre de archivo y renombrarlo





Macro que permite buscar una cadena de caracteres en el nombre de ficheros dentro de una carpeta, anteriormente se presentó una variante que hacía al revés recorriendo cada uno de los archivos de una carpeta buscándolo en la hoja de Excel una vez encontrado establecía la ruta y hacía link al archivo; en este caso busca una cadena de caracteres en los nombres de ficheros de una carpeta determinada, si lo encuentra hace un link al archivo.

Recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mailconectar Excel con Access y muchos ejemplos más.








   

El ejemplo permite recorrer una columna de un archivo de Excel desde la fila 5 hasta la última fila con datos, luego busca esa cadena de caracteres en cada uno de los archivos de en un directo, en caso de encontrarlo hace un link al fichero y escribe el path o ruta en la columna F.

En la siguiente variable se establece el path de la carpeta donde debe buscar los archivos, en este caso se utiliza el explorador de archivos de Windows para seleccionar la carpeta, también se puede asignar directamente si es más conveniente según las necesidades de cada programador.

path1 = CreateObject("shell.application").browseforfolder(0, "Seleccione Carpeta", 0).Items.Item.Path

La macro una vez encontrado el archivo que contiene la cadena de caracteres buscadas, específicamente en este caso busca un código (Column A) que está inserto en el nombre de cada uno de los nombres de ficheros, una vez encontrado el fichero lo renombra.

Por favor considera la posibiliad de aportar para sostener el sitio, desde el link del final del post se puede descargar el ejemplo de macro, cada usuario puede adaptarlo a sus necesidades, la codificación está abierta y es de libre, se brinda en forma gratuita.


⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Pasar datos de listbox a hoja Excel con Enter


Leer un archivo TXT separado con coma

Mostrar en el mismo listbox, suma, cuenta y promedio

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Luego de renombrar el archivo modificando el nombre del archivo, pasa al principio del nombre

La macro crea un link al archivo para ello,  con las siguientes variables se establece que texto se mostrará en el link y cual es la fila donde está la cadena de texto buscada en la hoja de Excel, se usan los códigos siguientes:

texhipv = a.Range("A" & codigo.Row)
dire = codigo.Row

La variable texhipv guarda el texto que se verá en el link, dire contiene la fila donde está el registro que coincide con el archivo y luego se hace el link al archivo, con el código que sigue, si se observa se ve como se utilizan las variables para formar el link al archivo; a continuación se muestra el código completo.

a.Hyperlinks.Add Anchor:=a.Range("A" & dire), Address:=nomnew, TextToDisplay:=texhipv
NunFich = NunFich + 1

Este último código es el que crea el hiperlink, hipertexto. hipervinculo o link al fichero, se podrá observar que en la última parte del código se utiliza la variable texhipv que es el texto que se mostrará en el link; el código donde se insertará el link se determina con la siguiente expresión:

a.Range("A" & dire)


Código que se inserta en un módulo

Sub hiperlinkficheroYURL()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path1 As String, ruta As String, texhipv As String
Set a = Sheets(ActiveSheet.Name)
uf = a.Range("A" & Rows.Count).End(xlUp).Row
'path1 = ActiveWorkbook.Path & "\324 PruebaHyper"
path1 = CreateObject("shell.application").browseforfolder(0, "Seleccione Carpeta", 0).Items.Item.Path
 If path1 = "" Then
 MsgBox "No ha seleccionado directorio carpeta Excel, seleccione directorio .", , "AVISO"
 Exit Sub
 End If
NunFich = 0
num = 0
For x = 5 To uf
cadbus = Cells(x, "A")
Set fso = CreateObject("Scripting.FileSystemObject")
Set carpeta = fso.getfolder(path1)
Set ficheros = carpeta.Files
For Each ficheros In ficheros
b = ficheros.Name
nomold = path1 & "\" & b
cadbusnew = " " & cadbus & " "
esp1 = InStr(b, cadbusnew)

If esp1 > 0 Then

esp2 = InStr(esp1 + 1, b, " ")
num = Mid(b, esp1 + 1, esp2 - 1 - esp1)
pp = Left(b, esp1 - 1)

sp = Mid(b, esp2 + 1)
nomnew = path1 & "\" & num & " " & pp & " " & sp
Name nomold As nomnew
busco = num
Set codigo = a.Range("A5:A" & uf).Find(busco, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
a.Range("F" & codigo.Row) = nomnew
texhipv = a.Range("A" & codigo.Row)
dire = codigo.Row
a.Hyperlinks.Add Anchor:=a.Range("A" & dire), Address:=nomnew, TextToDisplay:=texhipv
NunFich = NunFich + 1
End If
GoTo sal:
End If
Next ficheros
sal:
Next x
Set carpeta = Nothing
Set ficheros = Nothing
MsgBox ("Se encontraron " & NunFich & " ficheros en la carpteta seleccionada"), vbInformation, "AVISO"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends