Reemplazar 200 datos distintos

Hola Amigo;
Me ha surgido otra pregunta, perdona mi acoso con preguntas pero intento automatizar un poco mi trabajo y me vuelve a hacer falta tu ayuda. Te explico:
Tengo 2 columnas con 200 lineas (AA100:AB300). El texto que hay en la columna AA lo tengo que reemplazar por el texto de la columna AB. Me preguntaba si hay alguna manera de hacerlo automatico con una macro, ya que sino tendría que hacerlo uno por uno y son 200 reemplazos diferentes y es un proceso que tendré que hacer cada semana.
Gracias por tu ayuda.

1 respuesta

Respuesta
1
Para hacer eso puedes utilizar el siguiente código que me encontré (yo lo he probado y funciona perfectamente):
Sub MultiReemplazo()
Dim ColOne() As String, ColTwo() As String
Dim rngRange1 As Range, rngRange2 As Range
Dim intResponse As Integer
Dim intLookAt As Integer
Dim iCols As Long
Dim iRows As Long
Dim i As Long
On Error Resume Next
intResponse = MsgBox("Dando 2 Columnas de la Tabla" & vbCrLf & "Esta macro reemplazará un rango del usuario", vbExclamation + vbOKCancel, "Reemplazar")
If intResponse = vbOK Then
Set rngRange1 = Application.InputBox("Seleccione dos Columnas de la Tabla y el texto de reemplazo", "Multi-Reemplazo", ActiveCell.CurrentRegion.Address, , , , , 8)
If rngRange1 Is Nothing Then Exit Sub
' MsgBox rngRange1.Address
DoEvents
Set rngRange2 = Application.InputBox("Selecione el rango para reemplazar.", "Multi-Reemplazo", , , , , , 8)
If rngRange2 Is Nothing Then Exit Sub
' MsgBox rngRange2.Address
iCols = rngRange1.Columns.Count
iRows = rngRange1.Rows.Count
If rngRange1.Columns.Count > 2 Or rngRange1.Columns.Count < 2 Then
MsgBox "You must select a two-column range of cells", vbCritical + vbOKOnly
Exit Sub
End If
On Error GoTo errorhandler
ReDim ColOne(1 To iRows)
ReDim ColTwo(1 To iRows)
For i = 1 To iRows
ColOne(i) = rngRange1.Cells(i, 1)
ColTwo(i) = rngRange1.Cells(i, 2)
Next i
If Err <> 0 Then
MsgBox Err.Number & " :" & Err.Description
On Error GoTo 0
Exit Sub
End If
DoOver:
intLookAt = Application.InputBox("Digite 1 para coincidencia exacta , 2 para Parcial", "Multi-Reemplazo", 1, , , , , 1)
Select Case intLookAt
Case 1
'do nothing
Case 2
'do nothing
Case Else
MsgBox "Por favor digite 1 o 2"
GoTo DoOver
End Select
intResponse = MsgBox("Continuar(Si) o Retroceder(No)", vbQuestion + vbYesNoCancel, "Multi-Reemplazo")
If intResponse = vbCancel Then Exit Sub
If intResponse = vbYes Then
On Error GoTo errorhandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 1 To iRows
rngRange2.Replace What:=ColOne(i), Replacement:=ColTwo(i), LookAt:=intLookAt, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next i
End If
If intResponse = vbNo Then
For i = 1 To iRows
rngRange2.Replace What:=ColTwo(i), Replacement:=ColOne(i), LookAt:=intLookAt, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next i
End If
End If
Application.ScreenUpdating = True
MsgBox "Selección Reemplazada"
Application.Calculation = xlCalculationAutomatic
On Error GoTo 0
Exit Sub
errorhandler:
MsgBox "Error: " & Err.Number & " (" & Err.Description & ")"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
On Error GoTo 0
End Sub
Los pasos a seguir son, primero seleccionas tus dos columnas, segundo seleccionas la columna que vas a sustituir y tercero sigues los pasos indicados y listo.
[email protected]
Amigo mio, esta macro solo tiene un nombre y es IMPRESIONANTE. Ha salido todo perfecto a la primera y reemplaza los datos en un momento, espectacular
Una vez mas, mil gracias por tu ayuda

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas