Rutina para buscar y reemplazar un texto concreto en varios documentos de Excel

Quisiera una rutina en Excel que hiciera lo siguiente:
- Buscar y reemplazar texto dentro de páginas de excel, pero que la búsqueda sea en todos los archivos de excel que haya en un directorio indicado previamente.
Creo que me he explicado más o menos bien, pero para no hacer perder tiempo a nadie pondré un ejemplo:
- En C:\Mis documentos\luis tengo 230 archivos de excel (oposiciones a judicatura). A veces cambian un término y en vez de arrendatario ahora tengo que poner arrendatario/a y quisiera que buscara en todos e hiciera el cambio. Si además me dijera en qué archivos los ha cambiado, pues mejor.

2 Respuestas

Respuesta
1
Zidnebla :
Agregá un libro nuevo .
Eliminá todas las hojas, menos una, y nombrala "Manejo".
Volcá en las celdas lo siguiente :
A3 subdir
A4 busca
A5 cambia_por
Seleccioná el rango A3:B5 y ejecutá "Insertar/Nombre/Crear/Columna Izquierda".
Verifcá que las celdas B3, B4 y B5 tienen como nombre las leyendas de las celdas correspondientes de la columna A.
Volcá en ellas los siguiente
B3 C:\mis documentos\luis2
B4 arrendatario
B5 arrendatario/a
Grabá el libro, con el nombre que quieras.
Mediante ALT+F11 ingresá a Visual Basic.
Insertá un módulo (Insertar/Modulo).
Y allí copia el siguiente código.
************************
Option Explicit
Sub abre_varios()
Dim sd As String
Dim busca As String
Dim cambiax As String
Dim archs As String
Dim resp As String
Dim x As Integer
Dim ws As String
Dim wb As String
Dim dr As String
sd = Range("Subdir").Value
busca = Range("busca").Value
cambiax = Range("cambia_por").Value
If Right(sd, 1) <> "\" Then sd = sd & "\"
dr = "c:"
If Mid$(dr, 2, 1) = ":" Then dr = Left$(sd, 2)
archs = sd & "*.xls"
On Error GoTo ManejoErrores
'MsgBox sd & Chr(10) & busca & Chr(10) & cambiax
resp = Dir(sd, vbDirectory)
If resp = "" Then
MsgBox "No existe el directorio : " & sd & Chr(10) & "Verifique por favor."
End
End If
ChDrive dr
ChDir sd
Worksheets.Add
ActiveSheet.Name = " " & Format$(Now(), "yyyymmdd hhmmss")
ws = ActiveSheet.Name
ThisWorkbook.Worksheets(ws).Cells(1, 1) = "Subdir"
ThisWorkbook.Worksheets(ws).Cells(2, 1) = "busca"
ThisWorkbook.Worksheets(ws).Cells(3, 1) = "cambiax"
ThisWorkbook.Worksheets(ws).Cells(1, 2) = sd
ThisWorkbook.Worksheets(ws).Cells(2, 2) = busca
ThisWorkbook.Worksheets(ws).Cells(3, 2) = cambiax
x = 1
resp = Dir(archs, vbNormal)
Do While resp <> ""
If UCase(resp) <> UCase(ThisWorkbook.Name) Then
ThisWorkbook.Worksheets(ws).Cells(x + 4, 1) = resp
wb = Abre_arch(resp)
Cells.Select
ThisWorkbook.Worksheets(ws).Cells(x + 4, 2) = reemplazar(busca, cambiax)
Range("a1").Select
'***** cuidado con esto
Workbooks(wb).Close savechanges:=False ' True
x = x + 1
End If
resp = Dir
Loop
ThisWorkbook.Worksheets(ws).Select
Columns("B:B").EntireColumn.AutoFit
Exit Sub
ManejoErrores:
MsgBox "Error nro : " & Err() & Chr(10) & "Descripcion : " & Error()
End Sub
'*****************
'*****************
Private Function reemplazar(busca As String, cambiax As String) As Boolean
On Error GoTo ManejoErrores
'*** si no se encuentra el dato , va a ManejoErrores y devuelve FALSE
Selection.Find(What:=busca, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True).Activate
Cells.Select
'**** aqui se cambian los datos
'**** pero como no se grabara el archivo , no es necesario quitarlo
Selection.Replace What:=busca, Replacement:=cambiax, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
reemplazar = True
Exit Function
ManejoErrores:
' MsgBox Err() & Chr(10) & Error()
reemplazar = False
End Function
'********************
'********************
Private Function Abre_arch(arch As String) As String
Workbooks.Open FileName:=arch
Abre_arch = ActiveWorkbook.Name
End Function
************************
************************
Volvé a Excel y grabá el archivo.
Te comento la macro.
Mediante la función DIR, se verifica la existencia del Directorio.
Se establece ese directorio como el actual.
Se agrega una hoja (xxx) nueva (con nombre ej 2002/05/06 20:10:15, sin divisores ), en el libro que tiene la macro
Allí se vuelcan en las primeras celdas el directorio, la palabra a buscar y el palabra que la reemplaza.
Se buscan los archivos xls, también mediante DIR.
Para cada archivo XLS, se busca la palabra (busca) y se la reemplaza por otra (cambia_por o cambiax) .
En la hoja (xxx) se vuelca el nombre del libro y VERDADERO/FALSO si existe o no allí la palabra buscada.
EN ESTA VERSION, SE CIERRA SIN GRABAR, por lo que no se guardaran los cambios en los archivos XLS.
(Workbooks(wb).Close savechanges:=False ' True)
***********
Para probar la macro "abre_varios", que se ejecuta mediante "Herramientas/Macro/Macros..." o ALT+F8.
Creá un directorio "C:\Mis documentos\Luis2".
Y volcá allí, algunos de los archivo xls del directorio "C:\Mis documentos\Luis" .
Por favor, NO CREO QUE SEA CONVENIENTE, modificar los archivos con una macro, porque pueden darse situaciones no previstas.
Por ejemplo si tenemos la palabra "arrendatarioS" en un texto, y queremos cambiar "arrendatario" por "arrendatario/a", la palabra quedaría "arrendatario/aS", que no es lo pretendido.
Y como este, muchos otros ejemplos.
Quizás se podría modificar la macro para DEJAR ABIERTOS los archivos en los que se encuentre la palabra buscada. Y reemplazar manualmente EDICION/REEMPLAZAR ( o mediante macro) en cada uno.
Además, por favor, antes de hacer algún reemplazo automático, hacé una copia de los archivos o crea un archivo ZIP con estos.
No creo que sea agradable perder el control del contenidos de los 230 archivos porque los reemplazos no funcionaron como se esperaba.
Estoy a tu disposición por cualquier aclaración o ampliación.
Mucha suerte.
Gracias. Me ha gustado mucho la manera que has tenido de solucionarlo. Tan sólo una cuestión (que tu ya me aclaras al final)
Para mi lo más importante es que sea capaz de encontrar una palabra exacta dentro de una frase que se encuentra en una celda. Es decir, que encuentre sal en la siguiente frase el "salero colosal tiene sal". Tan sólo quiero encontrar la palabra sal.
No creo que me sirviera que me aparecieran todas las posibles soluciones y editarlo yo "a mano" ya que en derecho hay infinidad de términos parecidos y con la misma raíz.
Suerte y gracias por todo
Zidnebla :
Disculpame la demora, pero no estuve en la ciudad.
Voy a generar una Función o rutina para que cambie los datos, tratando de contemplar todas las posibilidades.
Aunque te reitero que me parece un riesgo hacer los cambios de manera "full automatic".
Quizás los mejor sea tener 2 versiones de macros, una que me muestre todos los cambios que haría (que palabras y donde) . Y otra que los realize y me diga cuantos.
Por favor, no cierres la pregunta, que en cuanto tenga la rutina te contesto.
La verdad es que me parece lo más oportuno, lo de tener 2 macros; una que me diga cuáles son los resultados de la búsqueda y otra que la ejecute.
No tengo que disculpar nada, al revés, te agradezco mucho que me ayudes.
Gracias y que tevaya todo bien. Tarda lo que necesites. No tengo demasiada prisa. Nunca hay que tener prisa en un favor
Antes que nada, disculpame la "demora" en la respuesta .
Te dejo la version 2, donde "selecciona las situaciones correctas" teniendo en cuenta lo siguiente.
La palabra buscada...
a)Puede ser comienzo de frase.
Entonces el carácter siguiente debe ser espacio, "." o ",".
b)Puede estar al final de la frase.
Entonces el carácter anterior debe ser espacio, "." o ",".
c) Puede estar en el medio y debe cumplir las condiciones para los caracteres anteriores y posteriores.
La sentencia
"Workbooks(wb).Close savechanges:=False "
Impide que los archivos modificados se graben.
Como en la version anterior se va a generar una hoja con los datos de las sentencias encontradas y donde se reemplazó.
Tené presente de hacer las pruebas sobre un directorio "copia".
Y que la macro trabaja sobre todas las opciones "que se me ocurren", pudiendo no ser todas las que existen.
El código a volcar en el modulo es el siguiente :
Option Explicit
Sub abre_varios_v2()
Dim sd As String
Dim busca As String
Dim cambiax As String
Dim archs As String
Dim resp As String
Dim x As Integer, y As Integer
Dim ws As String
Dim wb As String
Dim dr As String
Dim mirango As Range
Dim celda As Range
Dim RespBusc
Dim ok
Dim TipoCaso
sd = Range("Subdir").Value
busca = Range("busca").Value
cambiax = Range("cambia_por").Value
If Right(sd, 1) <> "\" Then sd = sd & "\"
dr = "c:"
If Mid$(dr, 2, 1) = ":" Then dr = Left$(sd, 2)
archs = sd & "*.xls"
On Error GoTo ManejoErrores
'MsgBox sd & Chr(10) & busca & Chr(10) & cambiax
resp = Dir(sd, vbDirectory)
If resp = "" Then
MsgBox "No existe el directorio : " & sd & Chr(10) & "Verifique por favor."
End
End If
ChDrive dr
ChDir sd
Worksheets.Add
ActiveSheet.Name = " " & Format$(Now(), "yyyymmdd hhmmss")
ws = ActiveSheet.Name
ThisWorkbook.Worksheets(ws).Cells(1, 1) = "Subdir"
ThisWorkbook.Worksheets(ws).Cells(2, 1) = "busca"
ThisWorkbook.Worksheets(ws).Cells(3, 1) = "cambiax"
ThisWorkbook.Worksheets(ws).Cells(1, 2) = sd
ThisWorkbook.Worksheets(ws).Cells(2, 2) = busca
ThisWorkbook.Worksheets(ws).Cells(3, 2) = cambiax
ThisWorkbook.Worksheets(ws).Cells(5, 2) = "Direccion"
ThisWorkbook.Worksheets(ws).Cells(5, 3) = "Leyenda"
ThisWorkbook.Worksheets(ws).Cells(5, 4) = "Posic"
ThisWorkbook.Worksheets(ws).Cells(5, 5) = "OK"
ThisWorkbook.Worksheets(ws).Cells(5, 3) = "Leyenda Final"
x = 1
resp = Dir(archs, vbNormal)
Do While resp <> ""
If UCase(resp) <> UCase(ThisWorkbook.Name) Then
ThisWorkbook.Worksheets(ws).Cells(x + 5, 1) = resp
wb = Abre_arch_v2(resp)
Range("a1").Select
Set mirango = Range(ActiveCell, ActiveCell.SpecialCells(xlLastCell))
mirango.Select
For Each celda In mirango
If VarType(celda.Value) = vbString Then
y = 1
RespBusc = InStr(y, celda.Value, busca, 1)
While RespBusc > 0
'*** ACA PUEDO PONER MAS COMPARACIONES
ok = 0
If RespBusc = 1 Then
If Len(celda.Value) = Len(busca) Then
ok = 1
TipoCaso = 1
ElseIf Len(celda. Value) > Len(busca) And InStr(1, " .,", Mid$(celda. Value, RespBusc + Len(busca), 1), 1) > 0 Then
ok = 1
TipoCaso = 2
End If
Else 'RespBusc > 1
If Len(celda.Value) = RespBusc + Len(busca) - 1 And InStr(1, " .,", Mid$(celda.Value, RespBusc - 1, 1), 1) > 0 Then
ok = 1
TipoCaso = 3
ElseIf Len(celda. Value) > RespBusc + Len(busca) - 1 And InStr(1, " .,", Mid$(celda. Value, RespBusc - 1, 1), 1) > 0 And InStr(1, " .,", Mid$(celda. Value, RespBusc + Len(busca), 1), 1) > 0 Then
ok = 1
TipoCaso = 4
End If
End If
ThisWorkbook.Worksheets(ws).Cells(x + 5, 2).Value = celda.Address
ThisWorkbook.Worksheets(ws).Cells(x + 5, 3).Value = celda.Value
ThisWorkbook.Worksheets(ws).Cells(x + 5, 4).Value = RespBusc
ThisWorkbook.Worksheets(ws).Cells(x + 5, 5).Value = ok
'ThisWorkbook.Worksheets(ws).Cells(x + 5, 5).Value = y
'ThisWorkbook.Worksheets(ws).Cells(x + 5, 6).Value = RespBusc
If ok = 1 Then
Select Case TipoCaso
Case 1
celda.Value = cambiax
Case 2
celda.Value = cambiax & Right(celda.Value, Len(celda.Value) - Len(busca))
Case 3
celda.Value = Left(celda.Value, RespBusc - 1) & cambiax
Case 4
celda.Value = Left(celda.Value, RespBusc - 1) & cambiax & Right(celda.Value, Len(celda.Value) - (RespBusc + Len(busca) - 1))
End Select
End If
ThisWorkbook.Worksheets(ws).Cells(x + 5, 6).Value = celda.Value
y = RespBusc + Len(busca)
x = x + 1
RespBusc = InStr(y, celda.Value, busca, 1)
Wend
End If
Next
Set mirango = Nothing
Range("a1").Select
'***** cuidado con esto
Workbooks(wb).Close savechanges:=False ' True
x = x + 1
End If
resp = Dir
Loop
ThisWorkbook.Worksheets(ws).Select
Columns("B:B").ColumnWidth = 9
Columns("C:C").ColumnWidth = 42
Columns("D:D").ColumnWidth = 6.43
Columns("E:E").ColumnWidth = 5.43
Exit Sub
ManejoErrores:
MsgBox "Error nro : " & Err() & Chr(10) & "Descripcion : " & Error()
End Sub
'********************
'********************
Private Function Abre_arch_v2(arch As String) As String
Workbooks.Open FileName:=arch
Abre_arch_v2 = ActiveWorkbook.Name
End Function
Disculpame nuevamente la demora.
Y suerte.
FJ
Respuesta
1
Pásame una dirección de correo para enviarte un archivo de ejemplo.
Hola Nilda, gracias por la prontitud de tu respuesta. Mi dirección es: [email protected]
Salio el archivo a tu correo.
Gracias por tu esfuerzo, te he mandado un correo diciéndote un pequeño problema, pero de todas maneras te puntúo ya como te mereces. Gracias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Autocompletar Texto

Quisiera saber si existe alguna forma de autocompletar texto pero, desdé una celda en Excel, es decir no con ningún combobox o un textbox sino dentro de la propia celda en la hoja de calculo, claro esto validado desde un rango. Ejemplo: Yo Tengo una...
1 respuesta

Concatenar datos por filas

Quiero una macro q me concatene filas fila = celdas: a2,b2,c2...m2 Quiero q me concatene la fila con separación de "|" y si al momento de concatenar la fila encuentra una celda vacía q lo concatene como "0" y el resultado lo ponga en la celda p2 y...
1 respuesta

Hacer una búsqueda en una hoja especifica de un libro excel

Quisiera saber como puedo modificar parte de una macro para que realice la búsqueda en una sola hoja por ejemplo hoja datos, y no en todo el libro. O bien ingresar la hoja a buscar mediante un inputBox. Sub ejemplo() Sheets("buscador").Select Dim...
1 respuesta

Userform combobox dependiente

Tengo una hoja columna A, B, C, D, con títulos, necesito que al Código ubicación fecha cantidad BFDAC12 RACK1 10-10-2012 1 FGTED52 RACK2 11-10-2012 2 DFREW34 RACK3 12-10-2012 3 BFDAC12 RACK4 13-10-2012 4 DFREW34 RACK3 14-10-2012 1 FDAC12 RACK4...
1 respuesta

Crear Formulario Excel (ayuda a un principiante)

Gurús del excel, estoy trabajando en un formulario de ingreso de datos y mi intención es aprender todo sobre la herramientas de formularios. El objetivo del formulario es entregar un código al usuario que lo ejecute y almacenar en otra hoja los datos...
1 respuesta

Buscar en rango aquellas celdas que sumen valor dado

Encontré estas pregunta y respuesta aquí en el foro que son por un problema casi idéntico a uno que yo tengo. La respuesta que dio el experto es muy buena, pero funciona sólo identificando dos celdas que cumplen la restricción, y no sé cómo modificar...
2 respuestas

Macro borrar datos de hoja sin borrar formato

Tengo una macro con la que me ayudaron, trabaja muy bien la cual busca datos en un libro y los anota en una hoja llamada buscador, pero a esta hoja no puedo darle formato ya que se elimina al usarlo, es decir por ejemplo si le pongo un fondo a la...
1 respuesta