VBA : Compter 1 occurence dans une plage dynamique

[cibleo]

Bonsoir le forum,

Pour bien comprendre, j'illustre avec le fichier joint (JP14)

Feuille "Synthese", clic sur Bouton 4, j'ai fait une recherche avec le mot "scanner" sur les feuilles de Janvier.

S'affichent alors toutes les lignes contenant ce mot.

En bout de colonne B s'affiche dynamiquement la mention "TOTAL", puis le nombre de fois où apparait le mot.

Dans la procédure ci-dessous, j'ai donc placé une instruction (en rouge) qui est l'équivalent de =NBVAL($C$2:$M$12)

Mais le résultat renvoyé est égal à 13 soit le nbre de cellules non vides.

Or le mot "scanner" apparait ici 15 fois sur un total de 13 cellules. (puisqu'un même mot peut figurer plusieurs fois dans une cellule).

Private Sub remplirsynthese2(£nomfeuille As Variant, VSearch As String)
Dim plage As Range, Cel As Range, Adrdeb As String
Dim lig As Long
 
With Sheets(£nomfeuille)
    'Ici Plage de recherche par mots (TextBox1)
    Set plage = .Range("B3:L" & .Range("a65536").End(xlUp).Row)
    With plage
.../...
[COLOR=darkred]ShtR.Cells(DerLiR + 2, 2).Value = "TOTAL"[/COLOR]
.../...
[COLOR=darkred]ShtR.Cells(DerLiR + 3, 2).FormulaR1C1 = "=COUNTA(R2C" & 3 & ":R" & DerLiR & "C" & 13 & ")"[/COLOR]
.../...

Comment puis-je parvenir à compter l'occurence saisie initialement dans la Textbox de mon formulaire figurant dans la plage dynamique de la feuille "Synthese" ?

Dois-je créer une fonction personnalisée ou m'inspirer de la solution de Boisgontier dans le fil ci-dessous ?

https://www.excel-downloads.com/threads/recherche-doccurence-sans-reference.95348/

Pouvez-vous m'aider à résoudre ce problème.

Merci Cibleo

 

[cibleo]

Re : VBA : Compter 1 occurence dans une plage dynamique

Bonsoir à tous

J'ai placé vos différentes fonctions dans le module 1 et les ai traduites en fin de procédure "remplirsynthese2" pour en afficher le résultat dynamiquement dans la feuille "Synthese".

j'ai testé, voir le résultat avec le mot "scanner" en minuscule sur Janvier.

pierrejean, ça fonctionne mais comment faut-il modifier tes fonctions pour ne pas tenir compte de la casse ?

Si je rentre "SCANNER" --> résultat 0, j'aimerais compter "scanner" en minuscule.
Problème non rencontré avec les fonctions de soenda et Roger2327.

ROGER2327, le 1er argument de ta fonction ne tient compte que d'une cellule, j'aimerais que ce soit une plage de cellules.

J'aimerais aussi la décliner pour faire un décompte par chauffeurs comme soenda et pierrejean.

Est ce possible ?
Elle est quand même complexe ta fonction, j'ai du mal à te suivre.

Soenda : rien à signaler

Bonne fêtes à tous

Cibleo

 

[pierrejean]

Re : VBA : Compter 1 occurence dans une plage dynamique

Re

Quelques Ucase la ou il faut
Voila les fonctions insensibles a la casse

 

[pierrejean]

Re : VBA : Compter 1 occurence dans une plage dynamique

Re

tu avais demandé, je crois ,une fonction pour la recherche du mot dans une plage
A partir de la nb_dans:

Function nb_dans_plage(mot As String, zone As Range)
Dim cel As Range
For Each cel In zone
  nb_dans_plage = nb_dans_plage + nb_dans(mot, cel.Value)
Next cel
End Function

 

[ROGER2327]

Re : VBA : Compter 1 occurence dans une plage dynamique

Bonjour à tous

Pas si simple d'imiter correctement un SOMMEPROD() un peu spécial en VisualBasic.
J'ai abandonné l'utilisation de Split, pour revenir comme pierrejean (beau boulot !) à exploiter InStr.
Ce qui donne :

[B][COLOR="DarkSlateGray"]Function compteMot9(plg As Range, mot As String, ParamArray clefs()) As Integer
[COLOR="SeaGreen"]' 5 Nivôse CCXVIII - Roger fecit.[/COLOR]
Application.Volatile
Dim ar As Range, cl As Range, txt As String, m As String, org As Long
Dim i As Long, j As Long, pos As Integer, s As Integer, PrFx, SuFx, nPr As Long, nSu As Long
Dim clf, ref
   ReDim clf(1 To plg.Rows.Count, 1 To 1)
   If UBound(clefs) = -1 Then ref = Empty Else clf = clefs(0).Value: ref = clefs(1)
   PrFx = Array(" ", Chr(160), "-", "(", ")", "[", "]", "{", "}", ",", ";", ".", """", Chr(147), Chr(171), Chr(133), ":", "/", "\", "!", "+", "_", "*", vbLf, vbCr)
   SuFx = Array(" ", Chr(160), "-", "(", ")", "[", "]", "{", "}", ",", ";", ".", """", Chr(148), Chr(187), Chr(133), ":", "/", "\", "!", "+", "_", "*", vbLf, vbCr, "s ", "s" & Chr(160), "s" & vbLf, "s" & vbCr)
   nPr = UBound(PrFx)
   nSu = UBound(SuFx)
   org = plg.Rows(1).Row - 1
   For Each ar In plg.Areas
      For Each cl In ar.Cells
         If clf(cl.Row - org, 1) = ref Then
            txt = " " & cl.Value & " "
            If Len(txt) > Len(mot) + 1 Then
               For i = 0 To nPr
                  For j = 0 To nSu
                     m = PrFx(i) & mot & SuFx(j): pos = InStr(1, txt, m, vbTextCompare)
                     Do While pos > 0: s = s + 1: pos = InStr(pos + Len(m) - 1, txt, m, vbTextCompare): Loop
                  Next j
               Next i
            End If
         End If
      Next cl
   Next ar
   compteMot9 = s
End Function[/COLOR][/B]

La fonction est paramétrable.

• [COLOR="DarkSlateGray"][B]=compteMot9(C2:C2; "scanner")[/B][/COLOR]

  donne le nombre d'occurrence du mot "scanner" dans la plage C2:C2. (Le premier paramètre doit toujours être une plage, ici réduite à une plage contenant une seule cellule.)
  

• [COLOR="DarkSlateGray"][B]=compteMot9(C2:M14;"scanner")[/B][/COLOR]

  donne le nombre d'occurrence du mot "scanner" dans la plage C2:M14.
  

• [COLOR="DarkSlateGray"][B]=compteMot9($C2:$M14;"scanner";$B2:$B14;"PASCAL")[/B][/COLOR]

  donne le nombre d'occurrence du mot "scanner" dans la plage $C2:$M14 sous condition que la ligne correspondante dans la plage $B2:$B14 contienne "PASCAL".

Apparemment, peu de différence avec la dernière proposition de pierrejean si ce n'est que ma proposition comptera 0 pour "scannera" ou "scannersscanners". (Toujours cette histoire de savoir si on cherche un mot ou une suite de lettres.)​

ROGER2327
#2473

 

[pierrejean]

Re : VBA : Compter 1 occurence dans une plage dynamique

Re

beau boulot = Appreciation fort agréable
Mais signée ROGER , alors la !!!
C'est le super cadeau de Noel

 

[cibleo]

Re : VBA : Compter 1 occurence dans une plage dynamique

Bonjour à tous et merci Roger, pierrejean

Dans la procédure "remplirsynthese2", j'ai traduit la fonction de Roger2327 ci-dessous au niveau de DerLiR + 6.

Le résultat des 3 fonctions + (la mienne : Nbval +sommeprod) s'affichent donc dynamiquement dans la feuille "Synthese".

 'Ci-dessous j'emploie les fonctions personnalisées de ROGER2327
 ShtR.Cells(DerLiR + 6, 3).FormulaR1C1 = "=compteMot9(R2C" & 3 & ":R" & DerLiR & "C" & 13 & " , """ & VSearch & """)"
 ShtR.Cells(DerLiR + 6, 5).FormulaR1C1 = "=compteMot9(R2C" & 3 & ":R" & DerLiR & "C" & 13 & " , """ & VSearch & """ , R2C" & 2 & ":R" & DerLiR & "C" & 2 & ", ""PASCAL"")"
.../... etc.

Lors d'une nouvelle recherche, ce que je ne comprends pas, c'est qu'il me place aussi au niveau de DerLiR + 1 la fonction de Roger ou une autre d'ailleurs , alors que je n'ai rien codé en ce sens.

Toutes les instructions de décompte (les 3 fonctions) sont placées en bout de procédure "remplirsynthese2".

N'est-il pas préférable de créer une procédure à part que j'appellerais par un call en fin de "remplirsynthese2".

Avec ces lignes à répétition, j'ai vraiment l'impression de massacrer le travail déjà mis en place par jp14

Il y a sûrement moyen d'optimiser tout cela.

Pour l'exemple, j'aimerais conserver la ligne d'en-têtes (les prénoms) + la fonction (Nbval + sommeprod) + l'une des 3. (parce que j'ai l'impression que cela risque de ramer)

Pouvez-vous m'aider à rectifier le tir.

Cibleo

 

[pierrejean]

Re : VBA : Compter 1 occurence dans une plage dynamique

Re

Une proposition

macro a adapter avec la fonction de ton choix :

Sub formules(feuille As String, Vsearch As String)
auteurs = Array("NBVAL + SOMMEPROD", "SOENDA", "PIERREJEAN", "ROGER2327")
personnels = Array("TOTAL", "PASCAL", "SYLVIE", "JOËLLE", "JEAN-LUC", "FRÉDÉRIQUE", "STÉPHANIE", "J-FRANÇOIS", "A PRÉVOIR")
DerLiR = Sheets(feuille).Range("A65536").End(xlUp).Row
For n = LBound(auteurs) To UBound(auteurs)
 Sheets(feuille).Cells(DerLiR + 3 + n, 2) = auteurs(n)
Next n
 Sheets(feuille).Cells(DerLiR + 3, 3).FormulaR1C1 = "=COUNTA(R2C" & 3 & ":R" & DerLiR & "C" & 13 & ")"
 Sheets(feuille).Cells(DerLiR + 4, 3).FormulaR1C1 = "=Compte(""" & Vsearch & """ , R2C" & 3 & ":R" & DerLiR & "C" & 13 & ")"
 Sheets(feuille).Cells(DerLiR + 5, 3).FormulaR1C1 = "=compte_mots(""" & Vsearch & """ , R2C" & 3 & ":R" & DerLiR & "C" & 13 & ")"
 Sheets(feuille).Cells(DerLiR + 2, 3) = "TOTAL"
For n = 6 To 13
 Sheets(feuille).Cells(DerLiR + 2, n - 1) = personnels(n - 5)
 Sheets(feuille).Cells(DerLiR + 3, n - 1).FormulaR1C1 = "=SUMPRODUCT((R2C" & 3 & ":R" & DerLiR & "C" & 13 & "<>"""")*(R2C" & 2 & ":R" & DerLiR & "C" & 2 & "=""" & personnels(n - 5) & """))"
 Sheets(feuille).Cells(DerLiR + 4, n - 1).FormulaR1C1 = "=test(""" & personnels(n - 5) & """,""" & Vsearch & """,R2C" & 2 & ":R" & DerLiR & "C" & 13 & ")"
 Sheets(feuille).Cells(DerLiR + 5, n - 1).FormulaR1C1 = "=cpte_mots_pour(""" & Vsearch & """,R2C" & 2 & ":R" & DerLiR & "C" & 13 & ",""" & personnels(n - 5) & """)"
 Sheets(feuille).Cells(DerLiR + 6, n - 1).FormulaR1C1 = "=compteMot9(R2C" & 3 & ":R" & DerLiR & "C" & 13 & ",""" & Vsearch & """,R2C" & 2 & ":R" & DerLiR & "C" & 2 & ",""" & personnels(n - 5) & """)"
Next n
End Sub

Vois le test sur Feuil1 du fichier joint (appel par test1)

 

[cibleo]

Re : VBA : Compter 1 occurence dans une plage dynamique

Bonjour à tous
Bonjour pierrejean et merci,

J'ai adapté ton code à mon fichier et l'ai appelé en bout de procédure "remplirsynthese2".

.../...
For Each Cel In plage
     If Not (Cel.Value Like "*" & TextBox1.Value & "*") Then
    If InStr(UCase(Cel.Value), UCase(Vsearch)) = 0 Then
        Cel.Value = ""
    End If
    End If
Next Cel
 End With
 
 [COLOR=red]Call[/COLOR] formules("Synthese", Vsearch)
End Sub

Donc le résultat des fonctions doit s'afficher dynamiquement sous mon tableau, voir ci-dessous, à partir de DerLiR + 2.



Pourtant, il reste encore une énigme à résoudre.

Pour aérer mon tableau, j'aimerais que DerLiR + 1 reste une ligne vierge. (Ici : ligne 33)

Or à chaque nouvelle recherche, DerLiR + 1 m'affiche toujours le résultat d'une fonction. (Voir illustration ci-dessus).

Je ne comprends pas pourquoi , parce que je n'ai rien codé en ce sens.

Il y a sûrement à rajouter une condition à rajouter au code !

Cibleo

 

[pierrejean]

Re : VBA : Compter 1 occurence dans une plage dynamique

Re

J'ai passé un bon moment (et frolé le petage de plombs)

Explication: L'appel de la macro formules etait en fin de remplirsynthese2
Mais remplirsynthese2 s'execute au moins 2 fois dans la macro recherchetexte
et par consequent formules egalement
L'ecriture en ligne Derlin +1 etait donc un residu de l'une des ecritures de formules
J'ai voulu mettre l'appel de formules en fin de macro Commandbutton1_click mais (et c'est la que je me suis inquiété de mon etat mental) il y a des exit sub dans cette macro
En definitive c'est donc apres le call Recherchetexte que j'ai fini par loger le call formules
Comme a ce moment le Vsearch n'est pas défini j'ai du le remplacer par Textbox1

Vois si cela va comme tu veux

 

[cibleo]

Re : VBA : Compter 1 occurence dans une plage dynamique

Re pierrejean,

tu est vraiment un as pierrejean, merci.

Je ris parce qu'au moment où j'ai découvert ta réponse, je crisais aussi sur un autre problème.

J'avoue que cela m'a fait du bien

FAQ : myDearFriend! Excel Pages

La raison de mon pétage de plombs se trouve dans la macro de MyDearFriend (lien ci-dessus) que j'ai voulu adaptée à mon cas.

Il s'agit de colorier en rouge l'occurence recherchée dans la plage dynamique (soit l'occurence saisie dans Textbox1)

J'ai intégré la macro dans le module de ma feuille "Synthese" puis essayé dans un module standard.

Remplacé l'argument "LeMot" par Vsearch.

Puis fait des essais en fin de procédure "remplirsynthese2" (les lignes surlignées en vert ci-dessous).

.../...
For Each Cel In Plage
     If Not (Cel.Value Like "*" & TextBox1.Value & "*") Then
    If InStr(UCase(Cel.Value), UCase(Vsearch)) = 0 Then
        Cel.Value = ""
    End If
    End If
Next Cel
 End With
[COLOR=darkgreen]Vsearch = Me.TextBox1.Value[/COLOR]
 
[COLOR=#006400]'Set plage = .Range("C2:M" & DerLir)[/COLOR]
[COLOR=darkgreen]'MotEnCouleur "scanner", Sheets("Synthese").Range("C2:M14")[/COLOR]
[COLOR=darkgreen]MotEnCouleur """ & Vsearch & """, Sheets("Synthese").Range("C2:M14")[/COLOR]
[COLOR=darkgreen]'MotEnCouleur "scanner", Sheets(£nomfeuille).Range("C2:M14")[/COLOR]
[COLOR=darkgreen]'MotEnCouleur TextBox1.Text, Sheets("Synthese").Range("C2:M14")[/COLOR]
 
End Sub

Rien n'y fait, les occurences ne se colorent pas en rouge.

Je n'y arrive pas , peut-être encore placé au mauvais endroit comme précédemment.

J'ai remplacé le fichier plus haut avec la modif de pierrejean.

Ce dernier point viendra clôturer le post.

Bonne soirée Cibleo

 

[pierrejean]

Re : VBA : Compter 1 occurence dans une plage dynamique

Re

Faire et defaire !!!

La solution est la suivante:
une ligne mise en commentaire dans miseenform2
'.Characters.Font.ColorIndex = 0
toujours les sorties de Commandbutton1 (on ne sait pas tres bien ou )

 

[cibleo]

Re : VBA : Compter 1 occurence dans une plage dynamique

Bonjour le forum
Bonjour pierrejean,

Le problème est résolu.

J'ai déplacé tes instructions ci-dessous :

Private Sub CommandButton1_Click()
  Dim Vsearch As String
  Dim Plage As Range, Cel As Range, AdrDeb As String
  Dim premier As Boolean, dernier As Boolean
    .../...     
    Case False
        If Trim(TextBox1.Value) = "" Then
            Call MsgBox("Quel est le TEXTE que je dois chercher ?" _
            & vbCrLf & "" _
            , vbInformation, "Problème de mémoire")
            Exit Sub
        End If
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Call recherchetexte
        Call formules("Synthese", TextBox1)
[COLOR=red]'Ici figuraient les instructions en vert, je les ai déplacées plus bas[/COLOR]
        If trouve = False Then
            Call MsgBox("Nom non trouvé", vbExclamation, Application.Name)
            Unload Me
            Exit Sub
         End If
        Call miseenforme2
        Call miseenforme
 
        [COLOR=darkgreen]DerLiR = Sheets("Synthese").Range("A65536").End(xlUp).Row[/COLOR]
[COLOR=darkgreen]Call MotEnCouleur(TextBox1, Range("C2:M" & DerLiR))[/COLOR]
 
    End Select
    ActiveWindow.DisplayZeros = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Et gardé l'instruction en vert dans "miseenforme2"

Private Sub miseenforme2()
With ShtR
    DerLiR = .Range("a65536").End(xlUp).Row
    If DerLiR = 1 Then Exit Sub
    .../...
      With .Range("C2:M" & DerLiR)
      .FormatConditions.Delete
      [COLOR=darkgreen].Characters.Font.ColorIndex = 0[/COLOR]
      .Characters.Font.FontStyle = "Normal"
      .HorizontalAlignment = xlGeneral
      .VerticalAlignment = xlTop
      .WrapText = True
  End With
End With
End Sub

Tout fonctionne à merveille.

Merci pierrejean

Bonne soirée à tous

PS : J'ai remplacé le fichier plus haut au post 38.

 

[cibleo]

Re : VBA : Compter 1 occurence dans une plage dynamique

Bonsoir le forum
et bonne année à tous

Je reviens avec mon fichier dans lequel j'ai placé 2 macros de mise en forme (Couleurs) dans le module 1.

Feuille "Synthese", Color_Heure me colore tous les horaires en rouge (10:00).

MotEnCouleur me colore l'occurence recherchée (saisie dans TextBox1) en bleu. (Case False)

Je les appelle dans la procédure ci-dessous.

Private Sub CommandButton1_Click()
  Dim Vsearch As String
  Dim Plage As Range, Cel As Range, AdrDeb As String
  Dim premier As Boolean, dernier As Boolean
    trouve = False
  Select Case Me.ComboChauffeurs.Visible
    [B]Case True[/B]
        If ComboChauffeurs.Value = "" Then
            Call MsgBox("Quel est le nom que je dois chercher ?" _
            & vbCrLf & "" _
            , vbInformation, "Problème de mémoire")
            Exit Sub
        End If
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Call recherchechauffeur
        If trouve = False Then
            Call MsgBox("Chauffeur non trouvé", vbExclamation, Application.Name)
            Exit Sub
         End If
 
        Call miseenforme2
        Call miseenforme
        [COLOR=darkgreen]DerLiR = Sheets("Synthese").Range("A65536").End(xlUp).Row[/COLOR]
        [COLOR=red]Call Color_Heure(Range("C2:M" & DerLiR), 3, "Italic")[/COLOR]
 
    [B]Case False[/B]
        If Trim(TextBox1.Value) = "" Then
            Call MsgBox("Quel est le TEXTE que je dois chercher ?" _
            & vbCrLf & "" _
            , vbInformation, "Problème de mémoire")
            Exit Sub
        End If
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Call recherchetexte
        Call formules("Synthese", TextBox1)
        If trouve = False Then
            Call MsgBox("Nom non trouvé", vbExclamation, Application.Name)
            Unload Me
            Exit Sub
         End If
        Call miseenforme2
        Call miseenforme
 
        [COLOR=darkgreen]DerLiR = Sheets("Synthese").Range("A65536").End(xlUp).Row[/COLOR]
        [COLOR=red]Call Color_Heure(Range("C2:M" & DerLiR), 3, "Italic")[/COLOR]
        [COLOR=blue]Call MotEnCouleur(TextBox1, Range("C2:M" & DerLiR), 5, "Normal")[/COLOR]
 
    End Select
    ActiveWindow.DisplayZeros = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Cela fonctionne bien sauf dans un cas bien précis : Case False

En effet, l'occurence recherchée peut être un horaire :

Si je saisis 10:00 dans Textbox1, la recherche s'effectue normalement, tous les horaires se mettent bien en rouge (Color_Heure) puis 10:00 (l'occurence recherchée) se met bien en bleu (MotEnCouleur)

Le problème c'est que je me retrouve avec des lignes vierges qui viennent s'insérer



Je ne pense pas que le problème puisse venir des 2 macros en question, puisque dans les autres cas de figure de recherche, elles fonctionnent parfaitement (faire une une recherche avec le mot "scanner" par exemple) ou une recherche par chauffeur.

Pouvez-vous à nouveau vous pencher sur mon problème ?

Cibleo

Ps : j'ai remarqué que les lignes s'inséraient à chaque alternance de dates !

 

[soenda]

Re : VBA : Compter 1 occurence dans une plage dynamique

Bonjour le fil, cibleo

J'ai reproduit le phénomène et je constate que les lignes vierges incriminées marqent les changements de jours.

Cela permet de gagner en lisibilité. Es-tu sûr que ce soit un problème ?

Bonne année 2010

 

[cibleo]

Re : VBA : Compter 1 occurence dans une plage dynamique

Bonsoir soenda

J'ai remis le fichier, cela reste un mystère

Si je fais une recherche avec 08:00 ou 08:15 le phénomène ne se produit pas

Au départ, j'ai cru que cela venait de la ligne d'en-têtes.

Cibleo