elementos unicos en una coleccion

17/12/2006 - 21:56 por Ivan | Informe spam
hola a todos

estoy intentando usar una coleccion para cargar en una hoja los
registros de otra que no esten ya en la 1ª.

para ello hago esto->

1º.- en el modulo de un formulario ->

Dim colFavoritos as Collection ' a nivel de modulo

en el evento Initialice del formulario cargo la 1ª celda de cada
registro de la 1ª hoja (en la que quiero cargar los no repetidos de la
otra) en la coleccion

With Worksheets("Favoritos")
If .[a2] <> "" Then
For Each celdaF In .Range("a2:a" & .[a65536].End(xlUp).Row)
On Error Resume Next
colFavoritos.Add celdaF ' tambien he probado con '',
CStr(celdaF)''
On Error GoTo 0
Next
End If
End With

2º.- en un modulo normal tengo esta funcion, que intenta cargar los
registros no coincidentes de la 2ª hoja en otra coleccion. Para ello
cargo (intento) en la segunda coleccion solo la direccion de los
registros que al intentar cargarlos en la 1ª col. no den error

Function Coleccion(ByVal hjNuevos As String, _
ByRef colPrincipal As Collection) As Collection
Dim celda As Range, fila As String
With Worksheets(hjNuevos)
If .[a2] = "" Then Exit Function
Set Coleccion = New Collection
For Each celda In .Range("a2:a" & .[a65536].End(xlUp).Row)
On Error Resume Next
colPrincipal.Add celda ' tambien he probado con '' , CStr(celda)
''
On Error GoTo 0
If Err.Number = 0 Then
fila = celda.Address(0, 0) & ":" & celda.Offset(0,
25).Address(0, 0)
Coleccion.Add fila
End If
Next
End With
End Function

3º.- en un boton del formulario intento actualizar/ la 1ª hoja de
esta forma

With Worksheets("Favoritos")
If .[a2] = "" Then
Worksheets("Seleccion").UsedRange.Copy .[a1]
Else
f = .[a65536].End(xlUp).Row
Set colF = Coleccion("Seleccion", colFavoritos)
For i = 1 To colF.Count
Set CeldaO = .Range("a" & f + i)
Worksheets("Seleccion").Range(colF(i)).Copy CeldaO
Next
End If
End With

no se lo que hago mal, pero me carga todos los registros, unicos o no.
Quizas lo que intento no tenga mucho sentido, pñero no deja de
intrigarme el motivo del error.

bueno, si podeis echarme una mano una vez mas os lo agradezco

un saludo y hasta pronto
Ivan
 

Leer las respuestas

#1 Héctor Miguel
17/12/2006 - 23:48 | Informe spam
hola, Ivan !

la 'causa' del error que comentas al final... ["no se lo que hago mal, pero me carga todos los registros, unicos o no"]
[segun parece] esta en el segundo procedimiento que expones ["Function Coleccion(..."]
-> ya que si su proposito es [segun expones]:
"cargo (intento) en la segunda coleccion solo la direccion de los registros que al intentar cargarlos en la 1ª col. no den error"

a) tienes al inicio del bucle "For Each celda In .Range("a2:a" &..." -> una instruccion On Error Resume Next
b) despues haces 'la carga' [intento] con: -> colPrincipal.Add celda ' tambien he probado con '' , CStr(celda) ''
c) INMEDIATAMENTE despues de la carga [o intento]... tienes una instruccion: -> On Error GoTo 0
d) la siguiente linea [If Err.Number = 0 Then] -> obviamente... NUNCA va a 'encontrar' un error 'distinto' de 0 [cero]

-> 'solucion' ?... -> elimina/omite/comenta/... la linea con la instruccion: -> On Error GoTo 0 ;)
o... ponla despues del 'End If' [por si necesitas 'controlar' otros errores en el codigo de la misma funcion o procedimiento]
creo que podras ver 'la logica' de una instruccion 'On Error GoTo 0' y cuando si/no es conveniente su uso...
[al menos... nunca ANTES de haber podido evaluar si la instruccion 'realmente' ha generado un error] :)

saludos,
hector.

__ la consulta original __
estoy intentando usar una coleccion para cargar en una hoja los registros de otra que no esten ya en la 1ª...
1º.- en el modulo de un formulario -> Dim colFavoritos as Collection ' a nivel de modulo
en el evento Initialice del formulario cargo la 1ª celda de cada registro de la 1ª hoja
(en la que quiero cargar los no repetidos de la otra) en la coleccion


With Worksheets("Favoritos")
If .[a2] <> "" Then
For Each celdaF In .Range("a2:a" & .[a65536].End(xlUp).Row)
On Error Resume Next
colFavoritos.Add celdaF ' tambien he probado con '', CStr(celdaF)''
On Error GoTo 0
Next
End If
End With
2º.- en un modulo normal tengo esta funcion, que intenta cargar los registros no coincidentes de la 2ª hoja en otra coleccion.
Para ello cargo (intento) en la segunda coleccion solo la direccion de los registros que al intentar cargarlos en la 1ª col. no den error


Function Coleccion(ByVal hjNuevos As String, _
ByRef colPrincipal As Collection) As Collection
Dim celda As Range, fila As String
With Worksheets(hjNuevos)
If .[a2] = "" Then Exit Function
Set Coleccion = New Collection
For Each celda In .Range("a2:a" & .[a65536].End(xlUp).Row)
On Error Resume Next
colPrincipal.Add celda ' tambien he probado con '' , CStr(celda) ''
On Error GoTo 0
If Err.Number = 0 Then
fila = celda.Address(0, 0) & ":" & celda.Offset(0, 25).Address(0, 0)
Coleccion.Add fila
End If
Next
End With
End Function
3º.- en un boton del formulario intento actualizar/ la 1ª hoja de esta forma


With Worksheets("Favoritos")
If .[a2] = "" Then
Worksheets("Seleccion").UsedRange.Copy .[a1]
Else
f = .[a65536].End(xlUp).Row
Set colF = Coleccion("Seleccion", colFavoritos)
For i = 1 To colF.Count
Set CeldaO = .Range("a" & f + i)
Worksheets("Seleccion").Range(colF(i)).Copy CeldaO
Next
End If
End With
no se lo que hago mal, pero me carga todos los registros, unicos o no.
Quizas lo que intento no tenga mucho sentido, pñero no deja de intrigarme el motivo del error.
bueno, si podeis echarme una mano una vez mas os lo agradezco

Preguntas similares