[RESUELTO] Copiar pegar bajo 2 criterios y 2 condiciones

[markotxe]

Buenas tardes,
Con una macro, estoy intentando actualizar una tabla (Hoja="Recap") desde varias tablas situadas en otra hoja ("Compet").
Tengo que exportar los datos (unos tiempos) bajo 2 criterios y 2 condiciones.

Los criterios son los siguientes (Los datos se exportan en función de:...)
- Del nombre
- Del tipo de prueba
Las condiciones son las siguientes (Los datos se exportan si...)
- Si la celda de destino esta igual a zéro o vacia.
- Si el tiempo de la celda de destino es superior al tiempo de la celda de origen.

Tras varios intentos, no consigo adaptar las diferentes macros presentadas en el foro.
Adjunto a bajo un documento muy simplificado, que, sabra (espero) estar mas explicito que mi.
Muchas gracias por vuestra atención, cualquier ayuda, consejos o recomendaciones serán muy apreciados

Marc

[markotxe]

Hola,
Entiendo que la pregunta, tal y como la he presentado, no anima mucho.
No me gustaría dejar pensar que lanzo un sujeto, así sin mas y que otros hagan el trabajo.
Pero la verdad, no sabia por que lado coger este proyecto. Por lo tanto, me disculpo sinceramente si no he dado buena impresión.
Esto dicho, no sigo inactivo.

He avanzado un poco y quería exponer aquí mis avances.
He conseguido:
- Copiar/pegar de una hoja a la otra, los datos que había que exportar
- Puedo exportar estos datos bajo las dos condiciones requeridas (If… Then… End If)
- Gracias a una bucle (For.. Next), puedo exportar los siguientes datos.

Pero...
No consigo todavía mandar los datos en la celda de destino adecuada.
Entiendo, que esta celda de destino la podríamos ubicar con los nombres y apellidos pero no sé hacer (pero sigo buscando...).

Codigo actual:

Código: Seleccionar todo

Sub ActualizarA ()
   Dim MiDoc as Object, LasHojas As Object   
       MiDoc = ThisComponent
       LasHojas = MiDoc.Sheets  
   Dim i as integer

 for i = 1 To 10
If LasHojas.getByName("Recap").getcellrangebyname("F11").Value = 0 then
   LasHojas.getByName("Recap").getcellrangebyname("F11").Value= LasHojas.getByName("Compet").getcellrangebyname("I2:I12").getcellbyposition(0,i).Value
end if
If LasHojas.getByName("Recap").getcellrangebyname("F11").Value> LasHojas.getByName("Compet").getcellrangebyname("I2:I12").getcellbyposition(0,i).Value then
   LasHojas.getByName("Recap").getcellrangebyname("F11").Value= LasHojas.getByName("Compet").getcellrangebyname("I2:I12").getcellbyposition(0,i).Value
end if
  
 next
   MsgBox "Se han pasado los datos correctamente"
End Sub

Muchas gracias.
Marc

[gustavodiaz00]

Hola proba esta modificación, no se si es lo que buscas pero es lo que entendí que querías hacer.

Código: Seleccionar todo

Sub ActualizarA ()
   Dim MiDoc as Object, LasHojas As Object   
       MiDoc = ThisComponent
       LasHojas = MiDoc.Sheets  
   Dim i as integer

 for i = 1 To 10
If LasHojas.getByName("Recap").getcellrangebyname("F" & Trim(str(i))).Value = 0 then
   LasHojas.getByName("Recap").getcellrangebyname("F" & Trim(str(i))).Value= LasHojas.getByName("Compet").getcellrangebyname("I2:I12").getcellbyposition(0,i).Value
end if
If LasHojas.getByName("Recap").getcellrangebyname("F" & Trim(str(i))).Value> LasHojas.getByName("Compet").getcellrangebyname("I2:I12").getcellbyposition(0,i).Value then
   LasHojas.getByName("Recap").getcellrangebyname("F" & Trim(str(i))).Value= LasHojas.getByName("Compet").getcellrangebyname("I2:I12").getcellbyposition(0,i).Value
end if
  
 next
   MsgBox "Se han pasado los datos correctamente"
End Sub

"F" & Trim(str(i))

F columna F

Trim(str(i))

Convierto el valor i en string y luego uso la funcion Trim que sirve para eliminar los espacios vacíos al inicio y al final de una cadena.

[markotxe]

Hola gustavodiaz00,
No es exactamente lo que busco... Me gustaría que los datos estén exportados así a las personas que le corresponden. Pero he visto una discusión (con una doble bucle...) que me ha dado que pensar y creo que no estoy lejos de conseguirlo.

De todos modos, no faltare de teneros informados.
Gracias por el interés manifestado.
Hasta muy pronto!

[markotxe]

Buenas noche,
Ya esta! Lo tengo, no habrá sido fácil pero estoy bastante satisfecho del resultado y funciona!
Al principio, he seguido una pista tortuosa, pretendía:
- Abrir un bucle
- Buscar correspondencia con los nombres entre las tablas de las 2 hojas
- Una vez la correspondencia establecida, desplazarme 4 celdas a la derecha para localizar la celda de destino.
- Comparar la celda de destino con la celda de origen (la que tiene los datos a exportar) para comprobar las condiciones.
- Exportar datos, si condiciones cumplidas
- Cerrar bucle y pasar a la linea siguiente...

Pero no conseguía, localizar la celda destino, ni con GetCellbyPosition ni con un Celladress…
Hasta que caí sobre la solution leyendo una discusión en un forum francófono...
La solución era la DOBLE BUCLE! Simple, limpia, eficaz...
Estoy feliz de compartirla con todos ustedes.

Muchas gracias al forum sin olvidar el señor GustavoDiaz00! A parte de dar soluciones tiene el merito de ayudarnos a plantear los proyectos y abordar las cosas con perspectiva.
Otra vez, muchas gracias y buenas noches, allí va el código!

Código: Seleccionar todo

 Sub Main
Dim oDoc as object, oFls as Object, oFlC as Object, OFlR as Object
Dim oZoneC as Object, oZoneR as object
Dim oCellC1 as Object, oCellC2 as Object, oCellR1 as Object, oCellR2 as Object
Dim i as integer, j as integer

oDoc = ThisComponent
oFls = oDoc.Sheets
oFlC = oFls.getByName("Compet")
oFlR = oFls.getByName("Recap")

oZoneC = oFlC.getCellRangeByName("F2:I12")
oZoneR = oFlR.getCellRangeByName("B2:G12")

For i = 0 to 10
	oCellC1 = oZoneC.getCellByPosition(0,i)
	oCellC2 = oZoneC.getCellByPosition(3,i)
	print oCellC1.String, oCellC2.value
	For j = 0 to 10
		oCellR1 = oZoneR.getCellByPosition(0,j)
		oCellR2 = oZoneR.getCellByPosition(4,j)
   if oCellR1.string = oCellC1.string and oCellR2.value = 0 then oCellR2.value = oCellC2.value      
   if oCellR1.string = oCellC1.string and oCellR2.value > oCellC2.value then oCellR2.value = oCellC2.value
	Next j
Next i
End Sub