Optimisation d'une fonction

Fermé
skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 - 30 juin 2014 à 10:43
skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 - 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
A voir également:

2 réponses

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
30 juin 2014 à 14:41
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

0
skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 54
Modifié par skk201 le 30/06/2014 à 16:56
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)
0
eriiic Messages postés 24569 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 28 décembre 2023 7 212
1 juil. 2014 à 00:06
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
0
skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 54
1 juil. 2014 à 10:24
Oui c'est beaucoup mieux :)

Merci beaucoup vos aides.

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