[RESUELTO] Encontrar las no coincidencias

Desarrollo de Macros y programación en UNO, usar las API, llamar programas externos...
Responder
markotxe
Mensajes: 27
Registrado: Jue May 02, 2019 9:47 am

[RESUELTO] Encontrar las no coincidencias

Mensaje por markotxe »

Buenas noches,
Este mensaje hace continuación a uno anterior (https://forum.openoffice.org/es/forum/v ... 50&t=14809).
El reto que me propongo llevar acabo llega a su fin (En gran parte gracias a este forum). Sin embargo me enfrento a una ultima dificultad y no sé como tratarla...

Resumen del proyecto
- Importar datos de otro libro [Resuelto] .(Gracias GustavoDiazOO, https://forum.openoffice.org/es/forum/v ... 50&t=14820 )
- Filtrarlos [Resuelto]
- Exportar los datos filtrados así a otro libro [Resuelto]
- Repartir los datos en el sitio adecuado de una tabla [Resuelto].

Mi problema
En la ultima etapa, los datos (aquí tiempos) se reparten segun un criterio (Apellidos y nombres).
Pero, a veces (muy a menudo), los nombres de las personas llegan con faltas de ortografía y por lo tanto, la macro no exporta los tiempos.
Me gustaría y es el objeto de este post, poder detectar y copiar en una tabla, todos los nombres de las personas que no han tenido coincidencia.
No se como hacer...

Ci-junto, un fichero ejemplo (muy simplificado), con el código que le acompaña.

Código: Seleccionar todo

REM  *****  BASIC  *****
Option Explicit
Public oDoc as object, oFls as Object, oFlC as Object, OFlR as Object
Public oZoneC as Object, oZoneR as object
Public oCellC1 as Object, oCellC2 as Object, oCellR1 as Object, oCellR2 as Object
Public oEpreuve as Object
Public i as integer, j as integer

Sub ActualizarTiempos()
oDoc = ThisComponent
oFls = oDoc.Sheets
oFlC = oFls.getByName("Compet")
oFlR = oFls.getByName("Recap")
oZoneC = oFlC.getCellRangeByName("G2:H25")
oEpreuve=oFlC.getCellRangeByName("H2")
oZoneR = oFlR.getCellRangeByName("B2:D15")
oFlC.getCellRangeByName("C6").String = "J"
call Bucle
end sub

Sub ActualizarTiemposJ()
oZoneC = oFlC.getCellRangeByName("J2:K25")
oEpreuve=oFlC.getCellRangeByName("K2")
oZoneR = oFlR.getCellRangeByName("B2:D15")
oFlC.getCellRangeByName("C6").String = "M"
call Bucle
end sub

Sub ActualizarTiemposM()
oZoneC = oFlC.getCellRangeByName("M2:N25")
oEpreuve=oFlC.getCellRangeByName("N2")
oZoneR = oFlR.getCellRangeByName("B2:D15")
oFlC.getCellRangeByName("C6").String = "P"
call Bucle
end sub

Código: Seleccionar todo

Sub Bucle ()	
    For i = 0 to 23     
	oCellC1 = oZoneC.getCellByPosition(0,i) ' Apellidos y nombres (Hoja Compet)
	oCellC2 = oZoneC.getCellByPosition(1,i) ' Celda de origen (Hoja Compet)
	
	For j = 0 to 13
	   oCellR1 = oZoneR.getCellByPosition(0,j)                                 'Apellidos y nombres (Hoja Recap)
	If oEpreuve.String = "25 Cr" then oCellR2 = oZoneR.getCellByPosition(1,j)  'columna de celdas de destino (Hoja Recap) 
    If oEpreuve.String = "50 Cr" then oCellR2 = oZoneR.getCellByPosition(2,j)
'#############################################################################
'###########   Condiciones, formatos, contador de mejoras  ####################
'############################################################################# 			
    If oCellR1.string = oCellC1.string and oCellR2.value = 0 then             
       oCellR2.value = oCellC2.value
       oCellC1.CellBackColor = 6749952
       oFlC.getCellRangeByName("C7").value = oFlC.getCellRangeByName("C7").value +1       
    ElseIf oCellR1.string = oCellC1.string and oCellR2.value > oCellC2.value then 
       oCellR2.value = oCellC2.value 
       oCellC1.CellBackColor = 6749952
       oFlC.getCellRangeByName("C7").value=  oFlC.getCellRangeByName("C7").value +1
    'Else
       'oCellC2.CellBackColor = 16750848
    End If    
 
	Next j
Next i
   If oFlC.getCellRangeByName("C6").String = "J" then call ActualizarTiemposJ
   If oFlC.getCellRangeByName("C6").String = "M" then call ActualizarTiemposM
End Sub
Gracias por vuestra atención
Atentamente

Marc
Adjuntos
Coincidencias.ods
(22.74 KiB) Descargado 156 veces
Última edición por markotxe el Mar Mar 10, 2020 6:28 pm, editado 2 veces en total.
OpenOffice 4.1.5 CALC, Window10
markotxe
Mensajes: 27
Registrado: Jue May 02, 2019 9:47 am

Re: [Calc] Encontrar las no coincidencias

Mensaje por markotxe »

Buenas tardes,
He encontrado una solución :D (Quizás me he precipitado un poco a la hora de pedir ayuda).
Esta, se queda en pocas lineas y estoy muy contento de compartirla con todos ustedes.

Allá, va el primer código:
Al principio de la bucle se copia todos nombres segun vayan llegando en la primera celda vacia de la columna "B"

Código: Seleccionar todo

Ligne = 11
   While oFlC.GetCellRangeByName("B" & Ligne).String <> ""
      Ligne = Ligne + 1
   Wend
   oFlC.GetCellRangeByName("B" & Ligne).String = oCellC1.String
Allá, va el segundo código:
En la columna B se borra el ultimo nombre copiado si coincidencia encontrada

Código: Seleccionar todo

       If oCellR1.string = oCellC1.string then
       oFlC.GetCellRangeByName("B" & Ligne).String = ""
       End If

Y Aquí, va el código entero:

Código: Seleccionar todo

Sub Bucle ()	
    For i = 0 to 22     
	oCellC1 = oZoneC.getCellByPosition(0,i) ' Apellidos y nombres (Hoja Compet)
	oCellC2 = oZoneC.getCellByPosition(1,i) ' Celda de origen (Hoja Compet)
'	ooCellC1.String = oFlC.getCellRangeByName("B11").String
   Ligne = 11
   While oFlC.GetCellRangeByName("B" & Ligne).String <> ""
      Ligne = Ligne + 1
   Wend
   oFlC.GetCellRangeByName("B" & Ligne).String = oCellC1.String
   
   
	For j = 0 to 13
	   oCellR1 = oZoneR.getCellByPosition(0,j)                                 'Apellidos y nombres (Hoja Recap)
	If oEpreuve.String = "25 Cr" then oCellR2 = oZoneR.getCellByPosition(1,j)  'columna de celdas de destino (Hoja Recap) 
    If oEpreuve.String = "50 Cr" then oCellR2 = oZoneR.getCellByPosition(2,j)
'#############################################################################
'###########   Condiciones, formatos, contador de mejoras  ####################
'############################################################################# 			
    If oCellR1.string = oCellC1.string and oCellR2.value = 0 then             
       oCellR2.value = oCellC2.value
       oCellC1.CellBackColor = 6749952       
       oFlC.getCellRangeByName("C7").value = oFlC.getCellRangeByName("C7").value +1
''       oFlC.GetCellRangeByName("B" & Ligne).String = "A" 
       
             
    ElseIf oCellR1.string = oCellC1.string and oCellR2.value > oCellC2.value then 
       oCellR2.value = oCellC2.value 
       oCellC1.CellBackColor = 6749952
       oFlC.getCellRangeByName("C7").value=  oFlC.getCellRangeByName("C7").value +1 
       'oCellC2.CellBackColor = 16750848
    End If  
       If oCellR1.string = oCellC1.string then
       oFlC.GetCellRangeByName("B" & Ligne).String = ""
       End If
   Next j
Next i
  If oFlC.getCellRangeByName("C6").String = "J" then call ActualizarTiemposJ
  If oFlC.getCellRangeByName("C6").String = "M" then call ActualizarTiemposM
End Sub

Gracias por vuestra atención, gracias al forum
SaludoOOs
Marc
OpenOffice 4.1.5 CALC, Window10
Responder