Mejorar una Macro

Buenas noches.
Tengo una consulta con esta macro.
Dim col As Range
Sub elim_texto_inicio()
On Error Resume Next
Set col = Application. InputBox("Elija columna para eliminar texto WBS y SDI", "Eliminar textos", , , , Type:=8)
With Range(col. Address)
If. Cells Is Nothing Then Exit Sub
If. Columns. Count > 1 Then Exit Sub
On Error GoTo 0
Application. ScreenUpdating = False
. Replace What:="WBS ", Replacement:=""
. Replace What:="SDI ", Replacement:=""
Application. ScreenUpdating = True
End With
Range(col. Address). Select
ActiveCell. Offset(0, 1). Select
ActiveCell.EntireColumn.Select
Selection. Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
With Selection
. FormulaR1C1 = "=IF(LEN(RC[-1])=21,MID(RC[-1],1,21-4),IF(LEN(RC[-1])=18,MID(RC[-1],1,18-6),IF(LEN(RC[-1])=10,MID(RC[-1],1,10-3),"""")))"
. Value =. Value
End With
End Sub
Tiene unos detalles que me gustaria corregir.
1. Luego que sale el inputbox apreto el boton cancelar, no ocurre nada como deberia ser, pero cuando ejecuto la macro por primera vez, todo funciona ok, cuando lo ejecuto por segunda vez y apreto el boton cancelar lo que ocurre es que inserta una columna, es decir la parte final de la macro se ejecuta, a que se debe?
2. Como agrego una condicional para que la macro solo corra cuando encuentre datos "WBS" Y "SDI" y no corra en cualquier lugar.

1 Respuesta

Respuesta
1
No quedo muy elegante, pero se cumple el objetivo:
Sub elim_texto_inicio()
Dim col As Range
Dim S As String
Dim E As Integer
Dim c As Integer
On Error Resume Next
Set col = Application.InputBox("Elija columna para eliminar texto WBS y SDI", "Eliminar textos", , , , Type:=8)
S = col.Address
If S = Empty Then Exit Sub
Application.ScreenUpdating = False
col.Select
Do Until Selection.Row = 65536
    Selection.End(xlDown).Select
DoEvents
Loop
Selection.FormulaR1C1 = "=COUNTIF(R[-65535]C:R[-1]C,""WBS"")"
E = Selection.Value
Selection.FormulaR1C1 = "=COUNTIF(R[-65535]C:R[-1]C,""SDI"")"
c = Selection.Value
Selection.Clear
If (E + c) = 0 Then Exit Sub
col.Select
With Range(col.Address)
If .Cells Is Nothing Then Exit Sub
If .Columns.Count > 1 Then Exit Sub
On Error GoTo 0
Application.ScreenUpdating = False
.Replace What:="WBS", Replacement:=""
.Replace What:="SDI", Replacement:=""
Application.ScreenUpdating = True
End With
Range(col.Address).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
With Selection
.FormulaR1C1 = "=IF(LEN(RC[-1])=21,MID(RC[-1],1,21-4),IF(LEN(RC[-1])=18,MID(RC[-1],1,18-6),IF(LEN(RC[-1])=10,MID(RC[-1],1,10-3),"""")))"
.Value = .Value
End With
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas