Rendre rapide Macro LibreOffice calc; filtre entre 2 dates

Bonsoir

Rendre rapide Macro filtre entre 2 dates LibreOffice calc

Même travail fait par macro Excel; plus rapide

Merci

Bonjour

Une solution; macro vba Excel ;(non convertie en vb calc), peu modifiee pour qu'elle s'daapte

Cordialement

Hello,

C'est normal que la macro de ta première macro était lente car tu faisait du balayage cellule par cellule pour réaliser ton filtre. En utilisant des tableaux (fonctions getDataArray et setDataArray) cela va beaucoup plus vite car on ne fait qu'un transfert de données avec la feuille et on travaille en mémoire.

Sub FiltrerEtCopierDates
    Dim oDoc As Object, oCompte As Object, oSheetReleve As Object
    Dim oCursor As Object
    Dim dateDebut As Date, dateFin As Date
    Dim i As Long, lastRow As Long, destRow As Long
    Dim currentDate As Date
    Dim cellValue As Variant
    Dim oDataSrc As Variant, oDataDest, DataRow, rgDest As Object
    oDoc = ThisComponent
    oCompte = oDoc.Sheets.getByName("Compte")
    oReleve = oDoc.Sheets.getByName("Relevé")
           ' Lire les dates de filtre
    dateDebut = oCompte.getCellRangeByName("I2").Value
    dateFin   = oCompte.getCellRangeByName("I3").Value
    ' Vérifier que les dates sont dans les bornes min/max
     If dateDebut <  oCompte.getCellRangeByName("K2").Value or dateFin >  oCompte.getCellRangeByName("K3").Value Then
        MsgBox "Cellules 'I2' et 'I3' doivent etre dans les limites selon Cellules 'K2' et 'K3'", 48, "Erreur"
        Exit Sub
    End If
       ' Trouver la dernière ligne utilisée dans Active
    oCursorActive = oCompte.createCursorByRange(oCompte.getCellRangeByName("A1"))
    oCursorActive.gotoEndOfUsedArea(True)
    oDataSrc = oCursorActive.getDataArray()
    lastRow = oCursorActive.RangeAddress.EndRow
    Redim oDataDest(O to LastRow)
    ' Vider les anciennes données de Relevé depuis A4:F...
    destRow = 3
    oReleve.getCellRangeByPosition(0,destRow, 5, oReleve.getRows().getCount() - 1).clearContents(7)
    ' Définir la première ligne de destination (ligne 4 = index 3)
    k=0
    ' Parcours des lignes à partir de A4 (index 3)
    For i = 3 To lastRow
         cellValue = oDataSrc(i)(0)    
      '  cellValue = oCompte.getCellByPosition(0, i).Value
        If cellValue > 0 Then ' Vérifie que c’est bien une date
            currentDate = cellValue
            If currentDate >= dateDebut And currentDate <= dateFin Then
                ' Copie de A à F (0 à 5), en tenant compte du type
                    DataRow = Array(oDataSrc(i)(0),oDataSrc(i)(1),oDataSrc(i)(2), oDataSrc(i)(3), oDataSrc(i)(4), oDataSrc(i)(5))
                    oDataDest(k) = DataRow
                    k = k + 1 
            End If
        End If
    Next i
    Redim Preserve oDataDest(0 to k-1)
    rgDest = oReleve.getCellRangeByPosition(0,destRow,5,k + destRow - 1 )
    rgDest.setDataArray(oDataDest)
    MsgBox "Filtrage terminé. " & (k) & " lignes copiées vers 'Relevé'.", 64, "Succès"
 '''Écrire les infos complémentaires en haut de la feuille Relevé
    oReleve.getCellRangeByName("A2").String = oCompte.Name
    oReleve.getCellRangeByName("C1").Value = dateDebut
    oReleve.getCellRangeByName("C2").Value = dateFin
End Sub

En plus avec ton clearContents(1023) tu supprimais tout le formatage de la table de sortie et tu étais obligeais de reformater. Avec mon clearContents(7) je n'efface que les données et donc j'ai viré ton reformatage en fin de code.
Ami calmant, J.P

Bonjour Jura

Merci pour la macro et les conseils

Salut