Optimisation d'une fonction

skk201 Messages postés 942 Date d'inscription Statut Membre Dernière intervention -
skk201 Messages postés 942 Date d'inscription Statut Membre Dernière intervention - 1 juil. 2014 à 10:24

Bonjour à tous,

J'ai trouvé cette fonction dans cette discutions : https://forums.commentcamarche.net/forum/affich-25537064-excel-nb-si-avec-ou

C'est une fonction qui permet de faire un NB.si "OU".

Mais comme le dit son programmeur, elle n'est pas optimisé.

J'aimerais l'utiliser pour compter le nombre de "Oui" dans une colonne dans un fichier avec des résultats en français et en allemand.

Donc j'aimerais que la formule compte les cellules qui contiennent les valeurs "oui" ou "ja".

Mais le problème c'est comme la recherche se fait sur une colonne entière, (comme le nombre de ligne est dynamique) alors le temps de calcule est trop long.

Est-ce que vous avez une idée comment l'optimisé ?

Voici la fonction :

Public Function CompterCelMot(plageTexte As Range, listeMots As Range) As Long
    Dim cTexte As Range, cMot As Range
    For Each cTexte In plageTexte
        For Each cMot In listeMots
            If InStr(cTexte, cMot) > 0 Then
                CompterCelMot = CompterCelMot + 1
                Exit For
            End If
        Next cMot
    Next cTexte
End Function

Merci de votre attention

Afficher la suite

A voir également:

Optimisation d'une fonction
Optimisation pc - Accueil - Utilitaires
Fonction si et - Guide
Optimisation découpe panneau gratuit - Télécharger - Outils professionnels
Fonction miroir - Guide
Fonction moyenne excel - Guide

2 réponses

Réponse 1 / 2

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Bonjour

avec une macro paramètée- on peut transformer en function si on le préfère

Option Explicit
Dim critère()
'------
Sub test()
Dim Derlig As Long, T_in
With Sheets(1)
     critère = Array("Oui", "Ja")
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     T_in = Application.Transpose(Range("A2:A" & Derlig))
     compterunmotoudeux T_in
End With
End Sub
'-----
Sub compterunmotoudeux(Tablo)
Dim cptr As Long, nbre As Long
For cptr = 1 To UBound(Tablo)
     If UCase(Tablo(cptr)) = UCase(critère(0)) _
          Or _
          UCase(Tablo(cptr)) = UCase(critère(1)) Then nbre = nbre + 1
Next
MsgBox "nombre total de " & critère(0) & " et  de " & critère(1) & " : " & nbre
End Sub

skk201 Messages postés 942 Date d'inscription Statut Membre Dernière intervention 54

Ancien message :

Je vais tester ça :)

(C'est sur je préfère la fonction, je vais tester voire ce que ça donne)

Option Explicit
Dim critère() 
'------
Function NB_OU(Choix1 As String, Optional Choix2 As String = "") As Integer
Dim Derlig As Long, T_in
With Sheets("Liste")

     critère = Array(Choix1, Choix2)
     Derlig = .Columns("BS").Find("*", , , , , xlPrevious).Row
     T_in = Application.Transpose(Range("BS2:BS" & Derlig))
End With
NB_OU = compter(T_in)
End Function
'-----
Function compter(Tablo As Variant) As Integer
Dim cptr As Long, nbre As Long
For cptr = 1 To UBound(Tablo)
     If UCase(Tablo(cptr)) = UCase(critère(0)) _
          Or _
          UCase(Tablo(cptr)) = UCase(critère(1)) Then nbre = nbre + 1
Next
compter = nbre
End Function

Est-ce une jolie conversion ? :)

Edit :

Il me dit que critère(0) n'est pas un sub valide O.o (Ligne 18)

Réponse 2 / 2

eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention 7 275

Bonjour à tous,

Si tes celulles contiennent ces mots seuls (pas inclus dans des phrases) tu peux tenter ça :

Public Function CompterCelMot(plageTexte As Range, listeMots As Range) As Long
    Dim cTexte As Range, cMot As Range
    For Each cMot In listeMots
        CompterCelMot = CompterCelMot + Application.CountIf(plageTexte, cMot)
    Next cMot
End Function

Ca devrait être rapide.

eric

skk201 Messages postés 942 Date d'inscription Statut Membre Dernière intervention 54

Oui c'est beaucoup mieux :)

Merci beaucoup vos aides.

Ça fait du bien de repasser en mode de calcule Automatique :)

Discussions similaires

Remplir une cellule (texte) en fonction d'une autre (texte).

Démarrage d'Android en cours - Optimisation de l'application

[Excel 2010] Remplir cellule d'après contenu d'une autre

Excel : Remplir une cellule en fonction d'une autre

Excel : colorer une cellule sous condition d'une autre ?

Votre réponse

Discussions similaires