** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Excel
  Mensajes nuevos Mensajes nuevos RSS - Agilizar comparación de datos
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoAgilizar comparación de datos

 Responder Responder
Autor
Mensaje
OvejaReina Ver desplegable
Nuevo
Nuevo


Unido: 04/Octubre/2014
Localización: Francia
Estado: Sin conexión
Puntos: 1
Enlace directo a este mensaje Tema: Agilizar comparación de datos
    Enviado: 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
Arriba
Emilio Ver desplegable
Administrador
Administrador

Santander

Unido: 08/Agosto/2004
Localización: España
Estado: Sin conexión
Puntos: 18821
Enlace directo a este mensaje Enviado: 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/
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable