Imprimir página | Cerrar ventana

Agilizar comparación de datos

Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Excel
Descripción del foro: Foro de Excel y VBA de Excel
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=79694
Fecha de impresión: 29/Febrero/2020 a las 04:46


Tema: Agilizar comparación de datos
Publicado por: OvejaReina
Asunto: Agilizar comparación de datos
Fecha de publicación: 04/Octubre/2014 a las 14:52
Hola a todos,
Tengo una lista de "codigos" para evaluar si son parecidos entre ellos o no. A parte tengo que saber cuantos codigos parecidos tiene cada codigo.
Para esto hice una macro que funciona bien, pero es muy lenta. Tomando en cuenta que a veces tengo que comprar listas de codigos de hasta 20000 codigos.
Como pueden ver en la macro, es importante saber de cuanto difiere un codigo con otro, esos datos los uso para otra macro.
Podrian darme algunas ideas para hacer mas rapido mi codigo?
Gracias de antemano




Sub verificacion()
Dim UNO, DOS, TRES, CUATRO, CINCO, SEIS, SIETE, OCHO, NUEVE, DIEZ, I, F, FF, c, NFT As Integer

'Declaracion de tumbles
UNO = 0
DOS = 0
TRES = 0
CUATRO = 0
CINCO = 0
SEIS = 0
'Bandera de codigos casi iguales
BanEvaluada = 0
BanEvaluadora = 0


NFT = Sheets("Contadores de celdas llenas").Cells(1, 2).Value 'Numero Total de filas a tomar en cuenta en la Matriz Bruta


Sheets("Codigos").Range(Cells(1, 13), Cells(NFT, 13)) = 0




'bandera codigo diferente
G = 0


'contador fila
F = 1 'Evaluada
FF = 2 'Evaluadora
'contador columna, tenemos que guardar la primera columna que da un numero al codigo
c = 2



Do While F < NFT + 1

        Do While FF < NFT + 1
       
        Cells(3, 24).Value = F
        Cells(3, 25).Value = FF
       
       
        'Comparando los codigos para saber de cuanto es la diferencia
       
        UNO = Sheets("Codigos").Cells(F, c).Value - Sheets("Codigos").Cells(FF, c).Value
        DOS = Sheets("Codigos").Cells(F, c + 1).Value - Sheets("Codigos").Cells(FF, c + 1).Value
        TRES = Sheets("Codigos").Cells(F, c + 2).Value - Sheets("Codigos").Cells(FF, c + 2).Value
        CUATRO = Sheets("Codigos").Cells(F, c + 3).Value - Sheets("Codigos").Cells(FF, c + 3).Value
        CINCO = Sheets("Codigos").Cells(F, c + 4).Value - Sheets("Codigos").Cells(FF, c + 4).Value
        SEIS = Sheets("Codigos").Cells(F, c + 5).Value - Sheets("Codigos").Cells(FF, c + 5).Value
     
       

        'Verificamos si el codigo es parecido o no
        If (Math.Abs(UNO) + Math.Abs(DOS) + Math.Abs(TRES) + Math.Abs(CUATRO) + Math.Abs(CINCO) + Math.Abs(SEIS) > 1) Then
        G = 2
        End If
       

       
        ' Si menor que dos entonces aumentamos el numero de codigos parecidos tanto para la evaluada como para la evaluadora
        If G < 2 Then
       
        BanEvaluada = BanEvaluada + 1
        Sheets("Codigos").Cells(F, 13).Value = BanEvaluada
       
        BanEvaluadora = Sheets("Codigos").Cells(FF, 13).Value
        BanEvaluadora = BanEvaluadora + 1
        Sheets("Codigos").Cells(FF, 13).Value = BanEvaluadora

        End If
       
        'Reiniciamos la bandera y pasamos al siguiente codigo
        G = 0
        FF = FF + 1
        Application.ScreenUpdating = False
        Loop
       
'Pasamos al siguiente codigo a evaluar
F = F + 1

'Tomamos el contador del nuevo codigo a evaluar
BanEvaluada = Sheets("Codigos").Cells(F, 13).Value

'Iniciamos el contador evaluador
FF = F + 1

Loop

End Sub




-------------
Oveja Reina



Respuestas:
Publicado por: Emilio
Fecha de publicación: 04/Octubre/2014 a las 15:36
Hola!

lo siento no entiendo nada, utilizar nombres de variables como esos acaban haciendo el código ilegible.

Para empezar declara debidamente esas variables, tal y como lo haces la ultima es integer, el resto son variant, con ello consigues que el proceso sea mas lento.

Otro consejo es detener la actualización de pantalla al comienzo del proceso así como el recalculo, para luego activarlos al finalizar el proceso.

With Aplication
   .ScreenUpdating = False
   .Calculation = xlManual
End With

...

With Aplication
   .ScreenUpdating = True
   .Calculation = xlAutomatic
End With



-------------
Saludos a todos desde Huelva

http://www.mvp-access.es/emilio/" rel="nofollow - http://www.mvp-access.es/emilio/



Imprimir página | Cerrar ventana