Modificar macro para actúe en un rango determinado
Vengo a solicitar ayuda para modificar esta macro, actualmente esta configurada para asignarla a un botón y que actúe en la celda seleccionada, por lo que necesito quien pueda ayudarme a modificarla, para que actúe de forma automática al ingresar los números en la celda (d8:e8), y presionar enter, Saludos Cordiales.
Sub Rut()
Dim Celda As Range
For Each Celda In Selection
If Len(Celda) = 9 Then
Celda = Left(Celda, 2) & "." & Mid(Celda, 3, 3) & "." & Mid(Celda, 6, 3) & "-" & Right(Celda, 1)
End If
Next
For Each Celda In Selection
If Len(Celda) = 8 Then
Celda = Left(Celda, 1) & "." & Mid(Celda, 2, 3) & "." & Mid(Celda, 5, 3) & "-" & Right(Celda, 1)
End If
Next
End Sub
1 Respuesta
.13/10/16
Buenas noches, Andy
He interpretado que ahora quieres que los numeros ingresados en el rango que indicas se modifiquen automáticamente.
Si así fuera,
Haz click con el botón derecho del mouse sobre la pestaña de la hoja donde quieres que ocurra lo que solicitas. Elije la opción "Ver Código" y pega lo siguiente:
Private Sub Worksheet_Change(ByVal Target As Range) '---- Variables modificables: '=== ANDY, modifica estos datos de acuerdo a tu proyecto: ElRango = "D8:E8" ' Target donde está el nombre a dar a la hoja '---- fin Variables ' '---- inicio de rutina: Set isect = Application.Intersect(Range(ElRango), Target) If Not isect Is Nothing Then If Len(Target) = 9 Then Target = Left(Target, 2) & "." & Mid(Target, 3, 3) & "." & Mid(Target, 6, 3) & "-" & Right(Target, 1) ElseIf Len(Target) = 8 Then Target = Left(Target, 1) & "." & Mid(Target, 2, 3) & "." & Mid(Target, 5, 3) & "-" & Right(Target, 1) End If End If Set isect = Nothing End Sub
Verás al principio del código una variable donde puedes indicar en qué rango de celdas debe hacer esa modificación.
Por otra parte eliminé el doble bucle For/Next para que lo haga en un solo paso.
.
Fejoal, te doy las gracias me ha funcionado perfectamente es lo que buscaba, sin embargo cuando utilizo una macro de borrado automático que tengo asignada a un botón, para limpiar dicho rango, me manda al depurador, favor solicito puedas orientarme nuevamente en como o que corregir para evitar este conflicto.
Cordiales Saludos!
Sub Limpiar()
'
' Limpiar Macro
' Limpia las celdas
'
'
Range("D8:E8").Select
Selection.ClearContents
Range("D17:F17").Select
Selection.ClearContents
Range("D19:F19").Select
Selection.ClearContents
Range("O5:P5").Select
Selection.ClearContents
End Sub
.
Hola, de nuevo
Está bien. La macro que grabaste afecta el rango que la que te compartí está evaluando.
Para evitar ese conflicto, reemplaza tu rutina por esta otra que detiene momentáneamente ese control y, al terminar, lo restituye:
Sub Limpiar()
'
' Limpiar Macro
' Limpia las celdas
Application.EnableEvents = False
Range("D8:E8").ClearContents
Range("D17:F17").ClearContents
Range("D19:F19").ClearContents
Range("O5:P5").ClearContents
Application.EnableEvents = True
End SubComo verás, este modo evita -además- los movimientos de pantalla.
Espero que ahora quede bien.
Un abrazo
Fer
.
¡Gracias! Pero muchas gracias, me sirvió de maravilla es justo lo que buscaba, ahora me anda perfecto.
Saludos Cordiales a ti!
.
Un placer, Andy
Me alegro de que te haya servido.
Vero que eres nuevo por aquí, ¿pero "util"?. En fin...
Saludos
Fernando
.
