Copiar fragmento del texto en otra celda
Diego buenas tardes...
TE consulto, no se como hacer este trabajo.
NEcesito copiar de mis descripciones ubicadas en C4:C6000 un fragmento del mismo.
Ej. Amoladora 9" - 2400w Sistema de extracción de polvo Cod.DWE4559-AR -DEWALT-
Lo que necesito es cortar todo lo que este desde la letra "c" de cod. Hasta antes del "-" y que me lo pegue en la columna A., pero sin la palabra Cod y el punto siguiente quedándome así... DWE4559-ARa su ves la descripción quedaría sin ese "cod." Ej: Amoladora 9" - 2400w Sistema de extracción de polvo -DEWALT- Espero que puedas ayudarme por que son muchísimos artículos y tardo muchísimo de a uno. Saludos cordiales y buen comienzo de año.
1 respuesta
Me enviaste esta pregunta y te anexo la macro.
Sub CortarFragmento()
'Por.Dante Amor
u = Range("C" & Rows.Count).End(xlUp).Row
If u < 4 Then u = 4
Range("A4:B" & u).ClearContents
For i = 4 To u
ini = InStr(1, Cells(i, "C"), "Cod.")
If ini > 0 Then
i2 = ini + 4
fin = InStr(i2, Cells(i, "C"), " -")
If fin > ini Then
cod = Mid(Cells(i, "C"), i2, fin - i2)
Cells(i, "A") = cod
des1 = Left(Cells(i, "C"), ini - 1)
des2 = Mid(Cells(i, "C"), fin)
Cells(i, "B") = des1 & des2
End If
End If
Next
End SubCambia en la macro
Cells(i, "A") = cod, la letra "A" por la columna en donde quieres el código.
En la macro te estoy poniendo la descripción sin el código en la columna "B", te recomiendo que dejes en la columna "C" el texto original, en la columna "A" el código y en otra columna la nueva descripción.
Cambia la letra "B" por la columna en donde quieras dejar la nueva descripción.
Feliz año 2015! Te desea Dante Amor
No olvides valorar la respuesta.
Dante como estas..
Me dice que la macro no esta habilita en este libro o puede que se hayan desabilitados las macro.
La probé en mi archivo de sistema y en uno nuevo y me dio el mismo error.
¿Qué puede ser?
Saludos
Dam. lo pude solucionar.
Era una macro que estaba molestando.
Te consulto. en casos de que el codigo este al final.
EJ. Zingueria Galv. Caños chapa 3" x 1m Cod.ZCHV000
Como tendria que modificarla por que en ese caso no me los copia.
y hay posibilidad que me suscriba el original.
Me reemplaze la descripcion de la columna C por la nueva..
Un abrazo grande
Te anexo la macro, el resultado te lo pone en la columna "C".
Te anexo la macro, el resultado te lo pone en la columna "C".
Sub CortarFragmento()
'Por.Dante Amor
u = Range("C" & Rows.Count).End(xlUp).Row
If u < 4 Then u = 4
Range("A4:A" & u).ClearContents
For i = 4 To u
ini = InStr(1, Cells(i, "C"), "Cod.")
If ini > 0 Then
i2 = ini + 4
fin = InStr(i2, Cells(i, "C"), " -")
If fin = 0 Then fin = Len(Cells(i, "C")) + 1
If fin >= i2 Then
cod = Mid(Cells(i, "C"), i2, fin - i2)
Cells(i, "A") = cod
des1 = Left(Cells(i, "C"), ini - 1)
des2 = Mid(Cells(i, "C"), fin)
Cells(i, "C") = des1 & des2
End If
End If
Next
End Sub
Dam buenos dias...
Me sigue tirando el mismo erro..
que puede ser..
saludos
¿Cuál error? ¿Qué mensaje te pone? ¿SI le das depurar en qué línea de la macro se detiene?
O envíame tu archivo para adaptar la macro.
Dam, buenas tardes..
Ye te envío un archivo al email solicitado.
Saludos
Con esta macro te pone el código en la columna B y la descripción en la C.
Sub CortarFragmento()
'Por.Dante Amor
u = Range("C" & Rows.Count).End(xlUp).Row
If u < 2 Then u = 2
'Range("B2:B" & u).ClearContents
For i = 2 To u
ini = InStr(1, Cells(i, "C"), "Cod.")
If ini > 0 Then
i2 = ini + 4
fin = InStr(i2, Cells(i, "C"), " -")
If fin = 0 Then fin = Len(Cells(i, "C")) + 1
If fin >= i2 Then
cod = Mid(Cells(i, "C"), i2, fin - i2)
Cells(i, "B") = cod
des1 = Left(Cells(i, "C"), ini - 1)
des2 = Mid(Cells(i, "C"), fin)
Cells(i, "C") = des1 & des2
End If
End If
Next
End SubRecuerda valorar la respuesta.
