Reforzar Macro Teléfonos
Buen dia,
Tengo una Macro que me ayudaron a realizarla en esta página, necesito un par de cosas para mejorarlo.
Primero lo que hago es convertir todas las columnas en formato GENERAL, para eso le cambio el formato y le doy columna por columna la opción TEXTO EN COLUMNA, si pueden ayudarme a agregar esa pequeña macro antes de iniciar mi macro actual seria de mucha ayuda.
Ademas después de finalizar la actual macro necesito que elimine los teléfonos que comienzan con el numero 9 y tengan mas de 9 dígito o menos de 9 dígitos.
EJM. 95654874545 9865845 985478548756
También los teléfonos que no comiencen con 9 y tengan mas o de 8 dígitos o menos de 8 dígitos.
EJM 458122 456568968 1235568879 658785
Es decir los teléfonos que comienzan con 9 tienen que tener 9 dígitos, los demás teléfonos deben tener 8 dígitos.
DEJO LA MACRO QUE UTILIZO, si se necesita el archivo con teléfonos lo puedo enviar.
Public FiRefor As Integer
Sub Formateo_Telefonos_Lima()
Dim INTENTAR As Long, i, j, UCol, Total As Integer
Dim Contador1, Contador2, contador3 As Long
Dim Temporal As String
Dim columna1 As String, columna2 As String
'Estos son los datos que metemos en macro. Ojo, tienen que estar ordenados para que la busqueda funcione,
'sino falla. Si se añade alguno debes ponerlo donde corresponde y el departamento también.
'Añadire CERRO DE PASCO que no estaba con la misma clave que tiene PASCO
Dim Departamento(), Clave(), DepInexistente()
Dim Primero, Ultimo, Inicio, Fin, Medio, AuxiCla, DepInexistentes As Integer
Dim DepBus, AuxiDep As String
Dim Encontrado, YaOrdenado, InformeOrden, EncontradoInexistente, HayRepesFila As Boolean
Departamento = Array("AMAZONAS", "ANCASH", "APURIMAC", "AREQUIPA", "AYACUCHO", _
"CAJAMARCA", "CERRO DE PASCO", "CUSCO", "CUZCO", "HUANCAVELICA", _
"HUANUCO", "ICA", "JUNIN", "JUNÍN", "LA LIBERTAD", _
"LAMBAYEQUE", "LORETO", "MADRE DE DIOS", "MOQUEGUA", "PASCO", _
"PIURA", "PUNO", "SAN MARTIN", "TACNA", "TRUJILLO", _
"TUMBES", "UCAYALI")
', "probatina", "añadido", "Otro más") 'Algunos más para probar algoritmo ordenación
Clave = Array(41, 43, 83, 54, 66, _
76, 63, 84, 84, 67, _
62, 56, 64, 64, 44, _
74, 65, 82, 53, 63, _
73, 51, 42, 52, 44, _
72, 61)
', 20, 20, 20) 'Algunos más para probar algoritmo ordenación
Primero = LBound(Departamento)
Ultimo = UBound(Departamento)
DepInexistentes = 0
FiRefor = 0
ThisWorkbook.Worksheets("reformateos").Cells.Clear
'Bueno, decía que los departamentos debían estar ordenados para que funcionara la búsqueda binaria por división del intervalo.
'Mejor si los ordenamos por si acaso. Es preferible la ordenación hacia atrás porque si se añade el departamento nuevo
'al final con una sola operación en el indice i del método de la burbuja irá a su sitio.
'Además, me he dado cuenta depués que es obligatorio ordenar. Ya que estos estimados anglosajones no ponen en su sitio
'las eñes ni los acentos en la comparación de cadenas en VisualBasic y la lista debe tener el orden a su antojo.
InformeOrden = False
For i = Primero + 1 To Ultimo
YaOrdenado = True
For j = Ultimo To i Step -1
If UCase(Departamento(j)) < UCase(Departamento(j - 1)) Then
YaOrdenado = False
AuxiDep = Departamento(j): Departamento(j) = Departamento(j - 1): Departamento(j - 1) = AuxiDep
AuxiCla = Clave(j): Clave(j) = Clave(j - 1): Clave(j - 1) = AuxiCla
End If
Next
If YaOrdenado Then Exit For Else InformeOrden = True
Next
'Lo siguiente aparecesi hubo que cambiar el orden, lo mejor para no perder tiempo sería poner a mano en orden los departamentos y claves
If InformeOrden Then
AuxiDep = ""
For i = Primero To Ultimo
AuxiDep = AuxiDep & Left(Departamento(i) + "____________________", 20) & " " & Str(Clave(i)) & vbCrLf
Next
Respuesta = MsgBox(AuxiDep & vbCrLf & vbCrLf & "MEJOR QUE LOS ORDENE ASI EN LA MACRO", vbInformation + vbokonli, "Departamentos desordenados para ANSI")
End If
INTENTAR = 2 '1era fila a verificar
Contador1 = 0 'contando los # incorrectos
Contador2 = 0
'columna1 = InputBox$("Ingrese la columna de teléfonos fijos a formatear : ")
'columna2 = InputBox$("Ingrese la columna de Departamento a considerar : ")
columna2 = "B"
While Range("A" & INTENTAR).Value <> ""
UCol = Cells(INTENTAR, Columns.Count).End(xlToLeft).Column
For j = 3 To UCol
columna1 = Chr(64 + j)
'Esto que tienes no estaba bien porque para todo teléfono verificacbas todas las condiciones
'y no es necesario porque si lo borras no necesita comprobacaiones posteriores, y si es recortado
'a una longitud donde quedará estable no se necesitan más comprobaciones tampoco
'Y ya que se calcula el temporal será bueno usarlo cuanto se pueda.
'Conviene empezar con una condición que cumplan la mayoría de teléfonos y les haga inmunes. Yo
'veo por ejemplo que hay muchos con 9 cifras y a esos no se les hace casi nada, luego
'esa será la primera condición. Luego veo que hay muchos con tinen 8 cifras y empiezan por 1, esa
'será la segunda condición. Asi habrá muchos teléfonos que se ahooren muchas comprobaciones, aunque
'estos aun deberan pasar la prueba de tener 4 cifras iguales seguidas o tener 123456 o comenzar por 18
Temporal = Range(columna1 & INTENTAR)
If Temporal <> "" Then
If Len(Temporal) = 9 And Left(Temporal, 1) = "9" Then
If Left(Temporal, 1) = "1" Or Left(Temporal, 1) = "4" Then
'Si 9 cifras y empieza por 1 o 4 se borra
Call Reformateo(Temporal, 1)
Temporal = ""
Call Reformateo(Temporal, 2)
Range(columna1 & INTENTAR) = Temporal
Contador1 = Contador1 + 1
End If
ElseIf Len(Temporal) = 8 Then
If Left(Temporal, 1) = "9" Then
'Si es de 8 dígitos y 1er dígito es 9 se adiciona un 9
Contador1 = Contador1 + 1
Call Reformateo(Temporal, 1)
Temporal = "9" & Temporal
Call Reformateo(Temporal, 2)
Range(columna1 & INTENTAR) = Temporal
End If
ElseIf Len(Temporal) = 7 Then
If Left(Temporal, 1) <> 9 And Left(Temporal, 1) <> 1 Then
'Si es de 7 dígitos (1er dígito diferente a 1 y 9) se antepone 1
Contador1 = Contador1 + 1
Call Reformateo(Temporal, 1)
Temporal = "1" & Temporal
Call Reformateo(Temporal, 2)
Range(columna1 & INTENTAR) = Temporal
End If
ElseIf Len(Temporal) = 6 Then
If Left(Temporal, 1) <> "9" Then
'DEPARTAMENTOS
'Hacemos una búsqueda binaria del departamento que es más eficiente que la secuencial
DepBus = Trim(UCase(Range(columna2 & INTENTAR)))
Inicio = Primero
Fin = Ultimo
Encontrado = False
Do
Medio = (Inicio + Fin) \ 2
If Departamento(Medio) < DepBus...
1 respuesta
Ya hace muchos días que tengo una pregunta pendiente tuya, no sé si la habrán eliminado ya, la tengo tan perdida que no la encuentro. La verdad es que la vi bastante complicada y vi que no añadía nada significativo a lo ya hecho, por eso me dio pereza y la dejé.
Es difícil que otro experto tome esta pregunta, por eso lo voy a intentar yo.
¿Dices qué todas las celdas de la hoja tengan formato general, no?
Mándame el libro por si has hecho alguna modificación y porque tampoco sé si lo tendré yo.
Hola Valero,
Hace unos días envíe el libro pero no se si lo has recibido, no tengo ninguna respuesta
Si, lo recibí. Pero llevo unos días de mucho ajetreo y el tuyo es un ejercicio de los que necesito tiempo. Además estoy pensando que no debe ser simplemente añadir las condiciones nuevas que dices sino que algunas de las antiguas ya no tendrá sentido aplicarlas. Tengo muchas preguntas pendientes de contestar, dame tiempo.
De acuerdo amigo, si tienes dudas me comentas.
Voy a ponerme, escribo antes para ver si no han eliminado la pregunta.
Espera. Mándame las condiciones completas que se hacían con los teléfonos, las apunté en borrador cuando lo hice para ya tiré ese papel. Es que ahora al mirar la macro he visto lo que puede ser un error que cometí en tiempos, pero para corregirlo necesito saber cuales eran las condiciones, esas que decían cosas como:
1) Si tiene 9 cifras y empieza por 1 o 4 se borra
2) Si tiene 8 cifras y la primera es un 9 se le añade un 9
3) Si tiene 7 cifras y la primera es distinta de 9 y de 1 se antepone un 1
...
...
Mándame las viejas y las nuevas porque hay que simplificarlas entre si. No estaría bien aplicar las viejas y luego las nuevas si las nuevas hace que alguna vieja carezca de sentido.
a claro, las condiciones están en este link http://www.todoexpertos.com/mitodoexpertos/question/yo9npxsrmxxzw/problema-con-macro
hasta el momento no he tenido muchos problemas con la macro, de hecho hace un par de días le agregue una macro mas
Sub eliminar()
'Por.DAM
For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
For j = Cells(i, Columns.Count).End(xlToLeft).Column To 3 Step -1
Select Case Len(Cells(i, j))
Case 9: If Left(Cells(i, j), 1) <> 9 Then Cells(i, j).Delete xlToLeft
Case 8: If Left(Cells(i, j), 1) = 9 Then Cells(i, j).Delete xlToLeft
Case Else: Cells(i, j).Delete xlToLeft
End Select
Next
Next
End Sub
Básicamente lo que hace es: Primero corre la macro que creaste luego empieza a correr la macro SUB ELIMINAR.
SOLO PARA QUE ESTE COMPLETO QUISIERA QUE antes de empezar estas macros primero convierta todas las columnas que encuentre información en formato GENERAL; yo actualmente lo estoy haciendo manual (primero cambio el Formato a General, luego le doy TEXTO EN COLUMNAS para que deje de estar en Texto)
No puedo seguir ese enlace porque es privado tuyo, me dice que no tengo permiso. Igual que no tendrías acceso a mi MiTodoExpertos. Deberás copiar las condiciones y pegarlas aquí para que pueda verlas.
Y si dices que has tenido muchos problemas con la macro dime cuáles son.
