Macro que redondea y elimina puntos de números
Buenas tardes amigo, como pueden observar en la imagen, tengo en la columna A, varios números. Necesito una macro que al darle clic al botón sea capaz de redondear los números y elimine los puntos de dicha columna, tal como podemos observar en la columna B que esta de color rojo.
2 respuestas
¡Gracias! Dante la fórmula funciona excelente
Gregorio Villarreal "probablemente alguien te de un código mas sencillo".
Utilizando la misma fórmula se puede convertir en macro.
Yeison López prueba la siguiente macro:
Sub EliminaPuntoRendondea()
With Range("B1:B" & Range("A" & Rows.Count).End(3).Row)
.Formula = "=SUBSTITUTE(LEFT(A1,LEN(A1)-3),""."","""")+ROUND(RIGHT(A1,3),0)"
.Value = .Value
End With
End Sub
Dante en la celda A1 tengo 1000000 y en la celda A5 tengo 79.000, al darle clic al botón azul me convierte el 1000000 que esta en la celda A1 en 1000. Y los 79.000 que están en la celda A5 en #¡VALOR. Quiero que los numero que no tengan puntos los deje tal y como están
A1 tengo 1000000 y en la celda A5 tengo 79.000
Una opción es homologar tus datos, todos deben tener punto decimal y dos decimales, tal y como aparece tu primer ejemplo; y no esperar que la macro resuelva todas las posibilidades.
¿Por ejemplo 78.613 el resultado es 78613 o 79?
En cambio, si tuvieras 78.613.00 entonces entra en la misma fórmula y el resultado sería 78613.
¿Quieres qué la macro ponga el resultado en la misma columna "A" o que te la escriba en la "B"?
Hola Gregorio que la macro ponga el resultado en la columna B.
Yeison disculpa, otra pregunta, los datos que están en la columna "A" por lo que observo, no son de formato números, ¿correcto? Porque el separador de Miles y el de decimales son puntos, esto lo convierte en formato texto.
Yeison te dejo este código, prueba y me avisas si es lo que necesitas, estuve probando y funciona, pero bueno en la práctica es que se ve la realidad.
Sub RedondeaTex()
Dim Largo, Part1, Part2 As String
Dim DatoO, DatoM As String
Dim Indicador, Indicador2 As String
Dim Registros As Integer
Range("a1").CurrentRegion.Select
Registros = Selection.Rows.Count
For i = 1 To Registros
DatoO = Range("a" & i)
DatoM = Range("a" & i)
Range("a" & i).Select
Selection.Replace What:=".", Replacement:=""
DatoM = Range("a" & i)
Largo = Len(DatoM)
Part1 = Left(DatoM, Largo - 2)
Indicador = Left(Right(DatoM, 2), 1)
Indicador2 = Right(Part1, 1)
If Indicador2 = "" Then
Indicador2 = 0
Else
End If
If Indicador >= 5 Then
Indicador2 = Indicador2 + 1
Else
End If
Range("a" & i) = "'" & DatoO
If Largo < 3 Then
Range("b" & i) = Indicador2
Else
Range("b" & i) = Left(DatoM, Largo - 3) & Indicador2
End If
Next
End SubSólo te queda asignarlo a la forma que tienes, probablemente alguien te de un código mas sencillo, pero mientras prueba este.
Gregorio, como podemos ver en la presente tabla podemos ver que en la tabla A1 tengo este valor 1000000, sin embargo al darle clic al boton azul me deja la B1 como 10000. La celda A6 esta 79 y me lo deja con el numero 1.
Necesito que me deje los valores que no tienen punto tal y como están
Si por lo menos en la 6 la macro asume que es 0,79 y lo redondea a 1, ¿lo qué necesitas es que si no tiene puntos no haga nada? ¿En este caso que escriba el 79?
Claro no se sabía que había algo mixto, intenta con este codigo:
Sub RedondeaTex()
Dim Largo, Largo2, Part1, Part2 As String
Dim DatoO, DatoM As String
Dim Indicador, Indicador2 As String
Dim Registros As Integer
Range("a1").CurrentRegion.Select
Registros = Selection.Rows.Count
For i = 1 To Registros
DatoO = Range("a" & i)
DatoM = Range("a" & i)
Range("a" & i).Select
Selection.Replace What:=".", Replacement:=""
DatoM = Range("a" & i)
Largo = Len(DatoM)
Largo2 = Len(DatoO)
If Largo <> Largo2 Then
Part1 = Left(DatoM, Largo - 2)
Indicador = Left(Right(DatoM, 2), 1)
Indicador2 = Right(Part1, 1)
If Indicador2 = "" Then
Indicador2 = 0
Else
End If
If Indicador >= 5 Then
Indicador2 = Indicador2 + 1
Else
End If
Range("a" & i) = "'" & DatoO
If Largo < 3 Then
Range("b" & i) = Indicador2
Else
Range("b" & i) = Left(DatoM, Largo - 3) & Indicador2
End If
Else
Range("b" & i) = DatoO
End If
Next
End SubCuando no tenga puntos no hace nada de lo contrario ejecutará según lo primero que solicitaste