Cómo evito un bucle infinito?

Junto con saludarles, vengo en pedirles ayuda con un procedimiento que escribí, pero que me genera un bucle infinito, el que no puedo reparar.

El procedimiento que necesito implementar, consiste en verificar la existencia de los códigos de clientes, ubicados en la columna “B” de la hoja “concrecion”, en la columna “A” de la hoja “clientes”. Si estos no aparecen en la hoja “clientes”, necesito insertar un indicador en la hoja “concreción”, para este caso, una “X” en la misma fila, columna “D”, por cada código que no se encuentre en la hoja “clientes”.

Sub nclientes()

Dim s1, s2 As Single
Dim u1, u2 As Range
Dim k1 As Integer

s1 = Timer()

'ubico cursor en hoja con los datos a buscar y comparar
Sheets("Concrecion").Select
Range("B2").Select

Do While Not IsEmpty(ActiveCell) 'hacer mientras no estén vacías
Set u1 = ActiveCell 'almacena rango
k1 = ActiveCell.Value 'guarda contenido a buscar

Sheets("Clientes").Select 'camia a la hoja donde buscar v1
Range("A1").Select

Do Until ActiveCell.Value = k1 'hace hasta ser igual a k1
If ActiveCell.Value = "" Then 'si celda vacía
u1.Offset(0, 2).Value = "X" 'imprime en 2 celdas a la derecha de la analizada, en hoja" concretado", para indicar que esta no se encuentra en hoja "clientes"
Exit Do 'finaliza ciclo para pasar a la siguiente celda en hoja "concrecion"

Else
ActiveCell.Offset(1, 0).Select 'de lo contrario, pasa a la siguiente celda de hoja "clientes" para continuar buscando
End If

Loop '2
Sheets("Concrecion").Select
U1.Offset(1, 0).Select 'pasa a la siguiente celda de la hoja "concreción" paraanalizar siguiente cliente

Loop '1
s2 = Timer()
MsgBox ("Procedimiento ejecutado en " & s2 - s1 & "Seg.")
End Sub

Como se darán cuenta, utilizo un código bien sencillo, no tengo mucha experiencia en VBA, así que si es posible hacer este procedimiento.

1 Respuesta

Respuesta
1

El problema es que usas Do ese tipo de instrucción además de lenta genera muchos problemas, una forma mucho más rápida de validar es leer el dato de la columna de b de la hoja concreción y con una función contar compararla en solo paso con todos los datos de la columna A de la hoja clientes, si cuenta es mayor a 0 quiere decir que ese nombre ya existe en la hoja clientes, si cuenta=0 ese clienteno existe y la macro te coloreara de verde el nombre en la hoja concreción y además te pondrá una POR en la columna DE, prueba la amcro y comentas.

Sub valida_nombre()
Set h1 = Worksheets("concrecion")
Set h2 = Worksheets("clientes")
Set clientes = h2.Range("a1").CurrentRegion
Set nombres = h1.Range("b1").CurrentRegion
With nombres
    filas = .Rows.Count
    For i = 1 To filas
        cliente = .Cells(i, 1)
        cuenta = WorksheetFunction.CountIf(clientes, cliente)
        If cuenta = 0 Then
            .Cells(i, 3) = "X"
            .Cells(i, 1).Interior.ColorIndex = 4
        End If
    Next i
End With
Set nombres = Nothing: Set clientes = Nothing
End Sub

Agradezco enormemente las instrucciones que me facilitaste James Bond, pero este me arroja el error ‘9’ en tiempo de ejecución: tiempo Subíndice fuera del intervalo,.

Al acceder a la ayuda, abre un documento web con el título “Suscripción fuera del intervalo (error 9)”, con la siguiente información:

“Solo puede obtenerse acceso a los elementos de las matrices y a los miembros de las colecciones dentro de los rangos definidos. Este error lo provocan las siguientes causas y tiene las siguientes soluciones:

Ha hecho referencia a un elemento de matriz que no existe. Es posible que el subíndice sea más grande o más pequeño que el rango de índices posibles o puede que la matriz no tenga las dimensiones asignadas en este punto en la aplicación. Compruebe la declaración de la matriz para comprobar los límites superior e inferior. Use las funciones UBound y LBound para hacer una condición de acceso a la matriz si trabaja con matrices que se redimensionan. Si el índice se especifica como una variable, compruebe la ortografía del nombre de variable.

Ha declarado una matriz pero no especificó el número de elementos. Por ejemplo, el siguiente código provoca este error:

VB

Copiar

  Dim MyArray() As Integer

  MyArray(8) = 234 ' Causes Error 9.

Visual Basic no proporciona la dimensión implícitamente de rangos de matriz no especificados como 0-10. Es por eso por lo que debe usar Dim o ReDim para especificar explícitamente el número de elementos de una matriz.

Ha hecho referencia a un miembro de la colección que no existe. Intente usar la construcción For Each...Next en lugar de especificar elementos de índice.

Usó una forma abreviada de subíndice que especificó implícitamente un elemento no válido. Por ejemplo, cuando se usa el ! operador con una colección, la ! especifica implícitamente una clave. Por ejemplo, Object! keyName . el valor es equivalente a Object. elemento (keyName). Value. En este caso, se genera un error si keyName representa una clave no válida de la colección. Para corregir el error, use un índice o nombre de clave válido para la colección.”

https://docs.microsoft.com/es-es/office/vba/language/reference/user-interface-help/subscript-out-of-range-error-9

Confirmar que escribí el código tal como lo enviaste, modificando solo los rango desde donde inicia la información, “B1” y “A1”, por “B2” y “A2”, respectivamente.

Lamentablemente no he tenido experiencia con matrices, generalmente trabajo con los ciclos do loop, los cuales me han dado buen resultado trabajándolos con información dentro de una misma hoja, pero al querer interactuar con otras hojas, me genera problemas. Evidentemente, tendré que actualizarme en VBA, pero mientras, agradeceré la ayuda que me puedas o puedan prestar con esto.

Ese tipo de error quiere decir que el elemento no existe como no pones la línea donde marca el error no sabría decirte que es por ejemplo el error se puede presentar en estas dos líneas

Set h1 = Worksheets("concrecion")
Set h2 = Worksheets("clientes")

Cuando alguna de las 2 hojas no existe mira el resultado de la macro que te proporcione, eneste caso es innecesario el uso de una matriz

Efectivamente. Tenía un error en el nombre de la hoja.

Ahora corre sin problemas y termina, pero marca con “x” en columna “c”, incluso si se encuentran todos en hoja “clientes”. Es como si no reconociera la hoja, a pesar de haber revisado bien los nombres de las hojas, tanto en el libro como en la macro; También, haciendo la prueba de eliminar un cliente de la hoja “clientes”, me marca todas las filas con “x”. Verifiqué incluso, haciendo correr la macro en una versión más antigua de Excel, pero me arrojaba los mismos resultados. Realmente no se que pueda ser.

¿Existe la posibilidad de que revises el libro con el que estoy trabajando?

https://dl.dropbox.com/s/h510nus0g05ypqj/transportes.xlsm?dl=0

Quizás facilite un poco verificar la distribución de los datos. Si te acomoda enviarme el mismo archivo con sugerencias, lo puedes hacer cargándolo en:

https://www.dropbox.com/request/gd7tjsUlqB7b7uiIgc8A

Revisé otra posibilidad de enviarlo, pero no encontré. También si hay alguna restricción en las políticas de Todo Experto, pero aparentemente no.

De antemano te quedo muy agradecido.

Te envío la macro adaptada a tus datos, el problema ahora es que le toma entre 10 y 5 minutos procesar más de 18000 mil filas y el tiempo no baja mucho empleando matrices.

Sub cliente_faltante()
Dim t1, t2, cliente As Single
Dim cuenta As Boolean
Dim h1, h2 As Object
Dim nombres, clientes As Range
t1 = Timer()
Set h1 = Worksheets("Concrecion")
Set h2 = Worksheets("Clientes")
Set nombres = h1.Range("B1").CurrentRegion
Set clientes = h2.Range("A1").CurrentRegion
With nombres
filas = .Rows.Count
For i = 2 To filas
cliente = .Cells(i, 2)
cuenta = WorksheetFunction.CountIf(clientes, cliente) > 0
If cuenta Then GoTo sig:
.Cells(i, 4) = "X"
.Cells(i, 2).Interior.ColorIndex = 4
sig:
Next i
End With
Set nombres = Nothing: Set clientes = Nothing
t2 = Timer()
MsgBox ("Procedimiento finalizado en " & t2 - t1 & "segundos.")
Set h1 = Nothing: Set h2 = Nothing
Set nombres = Nothing: Set clientes = Nothing
End Sub

¡Gracias! 

Ahora funciona de maravilla James. Te quedo infinitamente agradecido por el tiempo dedicado a ayudarme, y a el equipo de Todo Expertos que, por medio de esta plataforma, me permitió contactarte.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas