rutina demasiado larga

30/05/2006 - 11:39 por carmen | Informe spam
Hola a todos!

Tengo dos hojas de excel, del mismo libro, "Fondos" y "Lista original".

La hoja "Fondos" contiene, entre otros, los campos que me interesan,
que son "FondoID", "Precio" y "Fecha", y tiene en total alrededor de
24000 entradas.
La hoja "Lista original" contiene, tambien entre otros, los campos
"FondoID" y "Status",que puede ser Activo o Cerrado y tiene algunas
entradas menos, alrededor de 1600.

El problema que tengo que resolver en este punto es el siguiente: he de
comprobar que todos los valores de "FondoID" con "Status" Activo de la
hoja "Lista original" se encuentran al menos una vez en "FondoID" de la
hoja "Fondos". Si se repiten o no, me da igual, aunque de hecho lo
normal sera que se repitan, pero lo importante para mi es averiguar si
estan todos al menos una vez y, si encuentro algun "habitante" de la
hoja "Lista original" que no aparezca en "Fondos", lanzar un mensaje de
error o dejar constancia en un fichero de texto (pero esto ultimo no es
problema). El problema es que mi rutina tarda muchisimo, ha estado
corriendo durante 36 minutos y solo ha llegado hasta la entrada 106 de
la hoja "Lista original", es decir, ha cubierto mas o menos la decima
parte del proceso, y yo necesito que todo esto se realice en un periodo
de tiempo asequible, unos cuantos minutos, diez a lo sumo, porque esta
comprobacion se debera realizar cada dia tras la llegada de datos
nuevos...

Adjunto la rutina que uso, por si sirve de punto de partida, o alguien
encuentra algun error de principiante...

Suponiendo que "FondoID"=ColumnaA
"Fecha"=ColumnaB
"Precio"=ColumnaC todos estos en la
hoja "Fondos"
y en la hoja "Lista original" "FondoID"=ColumnaA
"Status"=ColumnaB
'###################################################################
For i = 11 To 1600

fondo = Sheets("Lista original").Cells(i, 1).Value

If Sheets("Lista original").Cells(i, 2).Value = "ACTIVE" Then

j = 1
Do While j <= 24000
If Sheets("Fondos").Cells(j, 1).Value = fondo Then
GoTo a
ElseIf Sheets("Fondos").Cells(j, 1).Value <> fund Then
flag=0
End If
j = j + 1
Loop
If flag=0 Then
MsgBox("Fondo " & fondo & " no encontrado")

ElseIf Sheets("Lista original").Cells(i, 2).Value = "CLOSED" Then

End If

a: Next i

'############################################################

Se le ocurre a alguien otro metodo que no implique estos dos "super
bucles"?

Muchas gracias!
Carmen
 

Leer las respuestas

#1 Juan M
30/05/2006 - 14:38 | Informe spam
hola carmen

Tengo dos hojas de excel, del mismo libro, "Fondos" y "Lista original".

La hoja "Fondos" contiene, entre otros, los campos que me interesan,
que son "FondoID", "Precio" y "Fecha", y tiene en total alrededor de
24000 entradas.
La hoja "Lista original" contiene, tambien entre otros, los campos
"FondoID" y "Status",que puede ser Activo o Cerrado y tiene algunas
entradas menos, alrededor de 1600.

comprobar que todos los valores de "FondoID" con "Status" Activo de la
hoja "Lista original" se encuentran al menos una vez en "FondoID" de la
hoja "Fondos". al menos una vez y, si encuentro algun "habitante" de la
hoja "Lista original" que no aparezca en "Fondos", lanzar un mensaje de
error

Suponiendo que "FondoID"=ColumnaA
"Fecha"=ColumnaB
"Precio"=ColumnaC todos estos en la
hoja "Fondos"
y en la hoja "Lista original" "FondoID"=ColumnaA
"Status"=ColumnaB




prueba el siguiente codigo, modifica lo que creas necesario segun tus
necesidades
en los lugares donde modifica/escribe valores estan como comentarios

Al no indicar que quieres que haga si lo encuentra o no lo encuentra o no es
necesario buscar lo indico como comentario

si tus libros de origen tienen muchas formulas es posible que debas poner el
modo de calculo en manual mientras se ejecuta la macro
y luego dejarlo como al principio

si tienes cualquier duda comentas?

un saludo
juan

Sub comprueba()
Dim celda As Range
Dim MiRango As Range
Dim MiOtroRango As Range
Dim c As Range

'inicializa los valores de los rangos, modifica segun tus necesidades
With Worksheets("Lista Original")
Set MiRango = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
With Worksheets("Fondos")
Set MiOtroRango = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

For Each celda In MiRango
'comprueba el texto de busqueda
If celda.Offset(0, 1).Value = "activo" Then
'busca el valor si el status esta activo
Set c = MiOtroRango.Find(celda.Value, LookIn:=xlValues)
'metodo de busqueda de valores
If c Is Nothing Then
MsgBox "No se encontro dato " & celdda.value
'mensaje si no encuentra lo que busca
' Exit Sub
'sale si no encuentra el valor en fondos quitar el comentario
Else
'aqui ha encontrado coincidencia al menos una
' celda.Offset(0, 5) = "Encontrado"
'escribe que lo ha encontrado 5 columnas a partir de la columna A
End If
Else
' si no debe buscarlo
' celda.Offset(0, 5) = "no buscado"
'si el valor no tiene el status activado
End If
Next celda
End Sub

fin codigo--

Preguntas similares