Accélérer le travail d'une macro

Bonjour à tous,

Je travaille encore sur le fichier de mon épouse. Ce fichier lui sert à comptabiliser les paiements de factures des fonctionnaires en AT ou maladie pro. Lorsque les factures arrivent en paiement venant d'un hôpital ou autres lieux de soins, il y a souvent plusieurs factures pour le même patient qui arrivent en même temps et mais avec un seul total d’où leur besoin de fusionner des cellules (x soins pour x €).

Lorsqu'elles doivent compter les paiement fait tous les mois, c'est le nombre de cellules "non vides" qui doit être pris en compte dans la colonne et non les sommes (ça c'est après :) ). Cette macro compte le nombre de cellules non vide même celles qui sont fusionnées mais ça rame, ça rame!!!!

Y a t-il un moyen pour accélérer un peu le principe. Cette macro travaille sur 12 colonnes (janvier.....Décembre) en même temps. Dans le fichier joint, juste pour vous donner une idée, c'est rapide car très peu de ligne et de cellules à compter!!

Merci à vous et bonne journée

EDIT: J'avais oublié le fichier

=NbCellulesNonVides(Q$7:Q$5000)

Function NbCellulesNonVides(plage As Range) As Long
    Dim ws As Worksheet
    Dim startRow As Long, col As Long, lastRow As Long
    Dim rng As Range, cell As Range
    Dim total As Long
    Dim counted As Object
    Dim key As String

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Set ws = plage.Worksheet
    startRow = plage.Row
    col = plage.Column

    lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
    If lastRow < startRow Then
        NbCellulesNonVides = 0
        GoTo CleanExit
    End If

    Set rng = ws.Range(ws.Cells(startRow, col), ws.Cells(lastRow, col))
    Set counted = CreateObject("Scripting.Dictionary")
    total = 0

    For Each cell In rng.Cells
        If cell.MergeCells Then
            key = cell.MergeArea.Address
            If Not counted.exists(key) Then
                counted.Add key, True
                If Len(Trim(CStr(cell.MergeArea.Cells(1, 1).Value))) > 0 Then
                    total = total + cell.MergeArea.Cells.Count
                End If
            End If
        Else
            If Len(Trim(CStr(cell.Value))) > 0 Then
                total = total + 1
            End If
        End If
    Next cell

CleanExit:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    NbCellulesNonVides = total
End Function

Bonjour

je pense qu'il est préférable de ne pas fusionner les cellules mais de compléter toutes les lignes avec le montant. Quitte à jouer avec la MFC pour mettre des valeurs successives en blanc et retirer la bordure. (ici police en gris pour la voir dans ma copie d'écran)

Stéphane

Bonjour bayard,

Honnêtement, ta fonction est déjà bien optimisée. On peut peut-être grappiller quelques centièmes de-ci de-là mais je doute qu'on puisse trouver un gain de temps significatif. Pour info je pense que cela dépend pas mal du PC, chez moi ta fonction était assez instantanée.

Non le vrai problème c'est comme souvent la manière de procéder. Je comprends tout à fait l'utilisation des cellules fusionnées + formule VBA dans une cellule, qui aide pour les novices, mais quand même quand on sait qu'un simple =NB(plage) suffirait si les cellules n'étaient pas fusionnées...

J'ai essayé de repartir "à l'aveugle", j'ai écrit cette 2e fonction, plus courte mais les temps de run sur le fichier d'exemple sont quasi-identiques. Cependant la tienne me semble plus optimisée sur des colonnes plus longues.

Public Function NbCells(ByVal rng As Range)
  Dim t: t = Timer
  Debug.Print "NBCELLS", rng.Address, Now

  ' count de base sans cellules fusionnées
  Dim nb As Long
  nb = WorksheetFunction.Count(rng)

  Set rng = Intersect(rng, rng.Parent.UsedRange)

  Dim i As Long, cellI As Range, nbI As Long
  For i = 1 To rng.Count
    Set cellI = rng.Item(i)
    If cellI.MergeCells Then
      ' la cellule est fusionnée, on ajoute son count (-1) et on skip les suivantes
      nbI = cellI.MergeArea.Count
      nb = nb + nbI - 1
      i = i + nbI
    End If
  Next i

  NbCells = nb

  Debug.Print Now, Timer - t
End Function

Le problème c'est qu'en VBA on n'a (à ma conaissance) aucun moyen d'extraire efficacement les plages fusionnées d'une Range, il faut obligatoirement itérer ce qui est très long. S'il y avait des filtres ce serait plus pratique.

Bonjour tout les deux,

Pour Raccourcix, lorsqu'ils reçoivent une facture, il y a le nombre et le type d'actes mais pas de détail de facturation donc pas possible de remplir toutes les cellules si ce n'est diviser la somme pour le nombre mais bof bof!!!

Saboh12617, déjà merci pour ton travail et effectivement le gain de temps est vraiment minime, tant pis quand on sait que les fonctionnaires ne sont jamais pressé mais ça faut pas lui dire , plaisanterie mise à part ils ne travaillent pas avec des bêtes de course, ils testeront ça la semaine prochaine et verront si ça leur va ou pas!!!

Encore merci à vous deux et bonne journée

re,

je vous propose une autre fonction, qui me semble environ 10 fois plus vite, à voir ...

Function f_NonVide(plage As Range)
     Dim i, Arr, s, som
     s = plage.Parent.Name & "!" & plage.Columns(1).Address(0, 0)     'référence de la première colonne de votre plage (incl le nom de la feuille)
     Arr = Evaluate(Replace("if(len(#)>0,1,0)", "#", s))     'matrice avec 1 pour les cellules non-vides
     For i = 1 To UBound(Arr)                'boucler la matrice
          If Arr(i, 1) = 1 Then som = som + plage.Cells(i, 1).MergeArea.Cells.Count     'pour les cellules non-vides on compte les cellules (fusionnées)
     Next
     f_NonVide = som
End Function

voir macro "teste" pour comparer les 2

PS la plage doit se trouver dans le même fichier, important (mais si nécessaire, ce "s" est adaptable)

PS2 fusionner doit se faire dans la première colonne, donc vertical et ne pas horizontal

EDIT : peut-être ".MergeArea.Rows.Count" serait mieux

Edit : bonjour Dan

Bonjour

Y a t-il un moyen pour accélérer un peu le principe.

Conseil pour un coup dans l'eau certainement... mais ma réponse est Oui ---> ne pas faire des fusions de cellules (comme le précise raccourcix). Cela n'apporte que des soucis surtout avec l'utilisation de VBA

Ce qu'il faut comprendre c'est que votre fusion déclenche le code sur 5000 lignes sur 12 colonnes --> soit 60000 cellules à calculer

Dans votre cas, attention à ne pas laisser une cellule fusionnée vide de données sans quoi le résultat sera erroné

Crdlt

Edit : oups BsAlv, désolé je n'avais pas vu votre post.

Bonjour BsAlv,

C'est hallucinant la vitesse de ta macro par rapport à toutes celles que j'ai pu tester!!!

Aussi rapide que si il y avait, comme le suggérait Saboh12617, un simple =NB (plage).

Je te remercie et je vais donner ça à tester aux filles la semaine prochaine!!!

Encore merci à vous tous et bonne journée.

C'est super @Bart, chapeau

Une autre possibilité avec un résultat immédiat même avec 50000 lignes

Sub Nb_NonNull()
For Each Cellule In Selection
Cellule.Value = Cellule.Offset(1, 0).Resize(50000, 1).SpecialCells(xlCellTypeConstants, 3).Cells.Count - 1
Next Cellule
End Sub

Sélectionner les cellules dont vous voulez calculer la valeur et exécuter la requête

A partir de chaque cellule, je me décale d'une ligne et je prends une plage de 50000 lignes. je compte le nombre de constantes (nombre et texte) et je retire 1 (le titre)

Stéphane

re, @raccourcix,

il y a des désavantages avec votre proposition

• l'utilisation de "specialcells" provoque un évent "change" , si cela est défavorable, il faut les bloquer avec "application.enableevents".
• xlCellTypeConstants compte uniquement les cellules avec un contenu fix, je crois, et ignore les cellules non-vide d'une formule (à vérifier)
• on ne s'occupe pas des cellules fusionnées, donc une plage fusionnée de 5 cellules = 1 au lieu de 5
• avantage ou désavantage, c'est une macro et ne pas une fonction personallisée, donc discutable. Il faut savoir qu'on a le même problème qu'on a aussi quand on compte les couleurs des cellules, la fonction se récalcule quand on change quelque chose dans la plage, donc si on fusionne ou défusionne quelque cellules, la fonction ne le sait pas et ne se met pas à jour . (autrement, on doit utiliser "volatile" mais ....)

Donc, je pense à une combinaison, récalculer les plages dans une macro et ajouter un bouton pour activer la macro.

Etonnamment, xlCellTypeConstants renvoie le nombre de cellules fusionnées

on peut toujours ajouter le nombre de cellules avec formules en additionnant le nombre de cellule obtenu avec SpecialCells(xlCellTypeConstants, 3) et avec SpecialCells(xlCellTypeFormulas, 3)

Sub Nb_NonNull()
For Each Cellule In Selection
Cellule.Value = Cellule.Offset(1, 0).Resize(50000, 1).SpecialCells(xlCellTypeConstants, 3).Cells.Count + _
   Cellule.Offset(1, 0).Resize(50000, 1).SpecialCells(xlCellTypeFormulas, 3).Cells.Count - 1
Next Cellule
End Sub

avec ici l'affichage des formules pour montrer le =E9

le résultat est bien 9 : le 3, les 4 du 5 et les 4 du =E9

Stéphane

re,

specialcells provoque une erreur quand on n'a pas ce genre de cellules ...

en PJ, votre macro adaptée, je ne sais pas l'origine du "-1". Apparament la maco est encore plus vite que mes essais.

Si je change vos 50000 en 5000 ou en 500000, cela n'a pas d'influence, bizarre, mais je pense que c'est préférable d'utiliser un nombre assez adapté. Un TS avec des cellules fusionnées, je ne pense pas que c'est une bonne idée.

La macro fait 83 fois cela dans un boucle pour créer 1.000 calculations, pour savoir comparer avec ma macro "teste". Plus tard on peut supprimer le boucle "iloop"

j'avais expliqué le -1 dans un message précédent = c'est pour retirer la valeur de la ligne de titre

je pense qu'il n'y a pas de différence entre 50000, 5000 ou 500000 car SpecialCells ne va jamais au delà de SpecialCells(xlLastCell)

faire l'essai avec une sélection des cellules vides. il ne va pas au delà de la cellule C4 car c'est la dernière cellule remplie même si la sélection était plus large

si les données s'arrêtent à la ligne 1000 et que la macro sélectionne 500 000 lignes avec le Resize, il s'arrêtera de rechercher à la ligne 1000 dans tous les cas

Stéphane

Rebonjour à tous,

Ah oui super cool que specialcells compte les cellules dans les cellules fusionnées. Par contre chez moi ça n'a pas trop l'air de fonctionner. SpecialCells me compte toutes les cellules de la plage... Ai-je mal compris ?

Public Function TESTCALL(rng As Range) As Long
  TESTCALL = rng.SpecialCells(xlCellTypeConstants, 3).Count + _
              rng.SpecialCells(xlCellTypeFormulas, 3).Count - 1

End Function

Public Function TESTCALL2() As Long
  TESTCALL2 = Application.Caller.Offset(1, 0).Resize(50000, 1).SpecialCells(xlCellTypeConstants, 3).Count - 1
End Function

En effet, je suis passé par une Sub car je n'ai pas réussi à obtenir un résultat correct dans une Function avec SpecialCells

Je laisse le sujet aux spécialistes VBA que je ne suis pas !

Stéphane

Re

@ raccourcix :
Malgré la sélection, j'ai chaque fois une erreur sur le code qui m'affiche "pas de cellules correspondantes"

Autre point, la variable "cellule" est une fonctionnalité excel. Donc là j'éviterai de l'utiliser et plutôt choisir "cel" par exemple

Par contre à tester mais en testant avec la proposition de specialcells, on pourrait faire ceci

1. mettre ce code dans la Feuil1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
    If .Column > 1 And .Column < 14 Then Call Nb_NonNull(Target)
End With
End Sub

2. mettre ce code dans le module

Sub Nb_NonNull(Target As Range)
Dim plage As Range
Dim col As Byte

On Error GoTo fin
col = Target.Column
Application.EnableEvents = False
Set plage = Cells(3, col).Resize(50000, 1)
Cells(1, col) = plage.SpecialCells(xlCellTypeConstants, 3).Cells.Count
fin: Application.EnableEvents = True
End Sub

Après si on modifie une cellule une colonne, le code renvoie l'info demandée en ligne 1
Et là cela est calculé directement et plus de formules en ligne 1

Il n'y a plus cas attendre si Bayard va revenir car on échange mais lui, il est où ??

Edit : j'ai modifié le code change en Selectionchange et pour ne prendre en compte que les colonnes janvier à décembre

raccourcix a écrit :

En effet, je suis passé par une Sub car je n'ai pas réussi à obtenir un résultat correct dans une Function avec SpecialCells

Je laisse le sujet aux spécialistes VBA que je ne suis pas !

Stéphane

Aucune idée non plus, mais d'après https://www.mrexcel.com/board/threads/vba-specialcells-behaving-differently-in-sub-and-function.1275... c'est que l'on ne peut pas utiliser SpecialCells depuis une fonction UDF.

L'alternative de @Dan qui appelle le Sub automatiquement me semble une alternative maline à cette limitation.

see also (et j'avais oublié cela !!!)

https://www.decisionmodels.com/calcsecretsj.htm

une macro pour vérifier ce "lastcell" avec la macro "Nb_NonNull_2" et on voit bien que specialcells s'arrêtent à la ligne 58 (ligne 5).

@Dan

@ raccourcix :

Malgré la sélection, j'ai chaque fois une erreur sur le code qui m'affiche "pas de cellules correspondantes"

C'est pour cela que j'avais inclus le titre dans le Resize. comme ça il y a toujours au moins une constante texte et on est certain que SpecialCells(xlCellTypeConstants, 3) ne renvoie pas d'erreur (d'où également le -1 pour retirer l'occurrence du titre).

Dans la version avec prise en compte des formules, il faut quand même gérer l'erreur générée par SpecialCells(xlCellTypeFormulas, 3) dans le cas où il n'y a pas de formule dans la plage.

Stéphane

@raccourcix

Mais j'avais le même souci avec les deux options. Je dois probablement faire une mauvaise manip...

Sinon avec ce que j'ai proposé ici --> https://forum.excel-pratique.com/s/goto/1256183, cela fonctionne très bien et me semble plus simple
Une amélioration à faire serait de trouver la ligne de la dernière cellule complétée et/ou fusionnée dans le tableau et de remplacer les 50000 par cette valeur.
Mais là, à priori je ne vois pas comment on y arriverait sachant que dans un groupe de cellules fusionnées c'est toujours la première cellule qui est prise en compte