COUNTIFS avec des choix multiples uniques

Bonjour,

Je cherche a compter le nombre de fois qu'une de ces 3 chaines de caractère ("MOR", "ECH", "TRAITE") apparaît dans un libellé. Le souci c'est qu'il y a des lignes où 2 de ces chaines peuvent être présentent en même temps. Ce qui fausse le décompte car cela double le nombre d’occurrence alors que la règle est de compter ou trouver l'une ou l'autre.

Pour l'instant CountIFs ne me donne pas satisfaction car il somme les 3. Ci-joint le fichier et ci-dessous le code :

Sub Denombrer()
Dim i As Integer, m As Integer, p As Integer, hook As Integer

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set ws = ThisWorkbook

    Set MaPlageRECH = Sheets(2).Columns(1)
    Set MaPlageNB = Sheets(2).Columns(5)
    m = ws.Sheets(1).Range("A65536").End(xlUp).Row
    Sheets(2).Select

    '_________ NB
        p = 0
    For Each Cellule In ws.Sheets(1).Range("A2:A" & m)

             If p < m Then
                 hook = Cellule.Row

                    ThisWorkbook.Sheets(1).Cells(hook, 3) = Application.WorksheetFunction.CountIfs(MaPlageRECH, Cellule, MaPlageNB, "*ECH*") + Application.WorksheetFunction.CountIfs(MaPlageRECH, Cellule, MaPlageNB, "*MOR*") + Application.WorksheetFunction.CountIfs(MaPlageRECH, Cellule, MaPlageNB, "*TRAITE*")
            Else
            Exit For
            End If

           p = p + 1

      Next
 Sheets(1).Activate
End Sub

Bonjour,

Une proposition avec Power Query, complément gratuit Microsoft à installer !?

Les données sont mises préalablement sous forme de tableaux structurées.

Cdlt.

Bonjour Jean-Eric, bravo et merci pour ce Power BI auquel je m'attendais pas du tout.

Par contre Je souhaiterais si possible rester sur de VBA car le fichier va être utilisé par des personnes qui ne connaissent pas l'existence de "RECHERCHEV" et qui souhaitent juste appuyer sur un bouton.

2. Par ailleurs ta requête n'est pas bonne car elle omet les référence en doublon. Par exemple la réf A1001 apparaît 3 fois dont deux lignes contenant les "mots clés recherchés". La requête n'a pris qu'une.

Re,

Dans ta demande tu parles de ne conserver que ECH, MOR et TRAITE ?

Et je suis parti sur le début du libellé. Peux-tu préciser ton souhait ?

Faut-il les caractères exacts ?

Cdlt.

Non, pas de caractère exacte. Dans le code j'ai mis des *MOR* ou *ECH* ou *TRAITE*.

De préférence en VBA svp... Merci

Salut Legénie,
Salut Jean-Eric,

en VBA, comme souhaité...

Sub Denombrer()
'
Dim tTab, tExtract
'
With Sheets(2)
    tExtract = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    tTab = .Range("A1:E" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Sheets(1)
    .Columns("A:C").Value = ""
    .Range("A1").Resize(UBound(tExtract, 1), 1).Value = tExtract
    .Range("A1").Resize(UBound(tExtract, 1), 1).RemoveDuplicates Columns:=1
    tExtract = .Range("A1:C" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    tExtract(1, 3) = "Nb"
    For x = 2 To UBound(tExtract, 1)
        For y = 2 To UBound(tTab, 1)
            If tTab(y, 1) = tExtract(x, 1) Then _
                If InStr(tTab(y, 5), "ECH") > 0 Or InStr(tTab(y, 5), "MOR") > 0 Or InStr(tTab(y, 5), "TRAITE") > 0 Then tExtract(x, 3) = CInt(tExtract(x, 3)) + 1
        Next
    Next
    .Range("A1").Resize(UBound(tExtract, 1), 3).Value = tExtract
End With
'
End Sub

A+

Bonjour,

Que fais-tu pour les doublons ?

Bonjour Jean-Eric,

j'imagine que ton dernier message s'adresse à moi ?
C'est mon interprétation de la prose du génie.

la règle est de compter ou trouver l'une ou l'autre

Même s'il y a doublon, le référence ne doit être incrémentée que de 1.
Nous verrons à l'autopsie !

Bien à toi

A+

@Curulis57 je suis épaté, vraiment bravo ! Et l'autopsie vous donne bien raison : c'est exactement la bonne interprétation.

Par contre nous avons un petit problème car je vois que le code efface toutes les données pour les récrire... je te rassure, le problème n'est pas au niveau de ton code mais de comment l'adapter à mon vrai fichier. J'ai essayé et c'était la catastrophe.

En fait, dans le fichier de base (ci-joint) les informations relative au comptage de nos 3 mots clés se trouve sur 12 colonnes (correspondant) à 12 mois

et ce à partir de la colonne 13. Et chaque colonne ne porte pas la description "Nb" mais plutôt "JAN", "FEV", ... il y a aussi 12 onglets correspondant à 12 mois où le programme va rechercher les infos.

Le programme va chercher dans l'onglet correspondant au mois en cours. Pour ce faire j'ai mis dès le départ ces lignes de code :

    Mois = Month(Date)
    If Mois = 1 Then
    RepActif = "JAN"
    Lettre = "M"
    ElseIf Mois = 2 Then RepActif = "FEV"
    Lettre = "N"
    ElseIf Mois = 3 Then RepActif = "MAR"
    Lettre = "O"
    ElseIf Mois = 4 Then RepActif = "AVR"
    Lettre = "P"
    ElseIf Mois = 5 Then RepActif = "MAI"
    Lettre = "Q"
    ElseIf Mois = 6 Then RepActif = "JUN"
    Lettre = "R"
    ElseIf Mois = 7 Then RepActif = "JUL"
    Lettre = "S"
    ElseIf Mois = 8 Then RepActif = "AOU"
    Lettre = "T"
    ElseIf Mois = 9 Then RepActif = "SEP"
    Lettre = "U"
    ElseIf Mois = 10 Then RepActif = "OCT"
    Lettre = "V"
    ElseIf Mois = 11 Then RepActif = "NOV"
    Lettre = "W"
    Else
    RepActif = "DEC"
    Lettre = "X"
    End If

Le challenge aujourd'hui c'est comment réadactaper votre jolie solution pour déjà que ça fonctionne sur un mois : AOUT. ( RepActif engloble déjà le mois).

Salut legénie,

ce qui serait génial, c'est de procurer d'entrée de jeu un fichier correspondant à la réalité : que de temps gagné !

La macro ci-dessous, située dans le module 'ThisWorkbook', détecte tout changement dans la colonne [D:D] de chaque feuille et démarre sitôt que la référence en [A:A] est présente.
Petite contrainte dans le cadre de cette macro mais tout peut être modifié si il y d'autres détails non mentionnés encore : la première feuille DOIT être la feuille 'RECAP' et les suivantes les diverses feuilles correspondant à l'ordre du calendrier.
Tu peux modifier le nom 'RECAP', bien sûr, la macro ne la connaît que sous son n° d'index.
Que les intitulés de feuille et de colonnes en 'RECAP' soient écrits en cyrillique ou vulcain n'a pas d'importance : seul l'ordre logique compte.

J'ai donc enlevé ton bouton devenu inutile. Je peux t'en mettre un quelque part qui fait "Coucou !" pour décorer, si tu veux!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim tTab, tRecap, sCol$
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If Not Intersect(Target, Sh.Columns(4)) Is Nothing And Sh.Index > 1 And Sh.Range("A" & Target.Row).Value <> "" Then
    Target = UCase(Target)
    tTab = Sh.[A1].CurrentRegion
    With Sheets(1)
        sCol = Chr(75 + Sh.Index)
        tRecap = .Range("A2:" & sCol & .Range("A" & Rows.Count).End(xlUp).Row).Value
        For x = 1 To UBound(tRecap, 1)
            tRecap(x, UBound(tRecap, 2)) = 0
            For y = 2 To UBound(tTab, 1)
                If tTab(y, 1) = tRecap(x, 1) Then _
                    If InStr(tTab(y, 4), "ECH") > 0 Or InStr(tTab(y, 4), "MOR") > 0 Or InStr(tTab(y, 4), "TRAITE") > 0 Then _
                        tRecap(x, UBound(tRecap, 2)) = CInt(tRecap(x, UBound(tRecap, 2))) + 1
            Next
        Next
        .Range("A2").Resize(UBound(tRecap, 1), UBound(tRecap, 2)).Value = tRecap
    End With
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

A+

Re, Génie,

même chose mais valable uniquement si 'RECAP' est déjà à jour.
Après un changement en colonne [D:D], au lieu de "flasher" les données en tableaux, la macro se contente de comparer l'ancienne et la nouvelle valeur, opérant directement l'opération dans la seule et exacte cellule correspondant au changement.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim iRow%, iNbOld%, iNbNew%, sData$
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If Not Intersect(Target, Sh.Columns(4)) Is Nothing And Sh.Index > 1 And Sh.Range("A" & Target.Row).Value <> "" Then
    Target = UCase(Target)
    sData = Sh.Range("AAA" & Target.Row).Value
    iNbOld = IIf(InStr(sData, "ECH") > 0 Or InStr(sData, "MOR") > 0 Or InStr(sData, "TRAITE") > 0, -1, 0)
    iNbNew = IIf(InStr(Target, "ECH") > 0 Or InStr(Target, "MOR") > 0 Or InStr(Target, "TRAITE") > 0, 1, 0)
    If iNbOld + iNbNew <> 0 Then _
        iRow = Sheets(1).Columns(1).Find(what:=Sheets(Sh.Index).Range("A" & Target.Row).Value, lookat:=xlWhole, LookIn:=xlValues).Row: _
        Sheets(1).Range(Chr(75 + Sh.Index) & iRow).Value = Sheets(1).Range(Chr(75 + Sh.Index) & iRow).Value + (iNbOld + iNbNew)
    Sh.Range("AAA" & Target.Row).Value = ""
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
Sh.Range("AAA1:AAA" & Sh.Range("AAA" & Rows.Count).End(xlUp).Row).Value = ""
If Not Intersect(Target, Sh.Columns(4)) Is Nothing And Sh.Index > 1 Then Sh.Range("AAA" & Target.Row).Value = Target
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'
End Sub

Tous les chemins ne mènent-ils pas Rome ?

A+

Curulis57, j'espère que vous ne m'en voudrez pas... et navré de ne pas avoir posté depuis le départ le fichier de départ ou le vrai scénario car je me rend compte combien de fois vous avez raison. Au début l'autopsie vous donnait raison mais là on s'en éloigne et c'est de ma faute. J'espère qu'il n'est pas trop tard. Je vous ai joint les 2 fichiers du processus ( à mettre dans un même répertoire, svp), que voici :

1. J'ai 2 fichiers : CompteSI (qui regroupe mon portefeuille avec toutes les informations glanées dans le 2e fichier) et OpérationSurQuittance (qui contient les montants des encaissements et les libellés où apparaissent les "*MOR*", "*ECH*" et "*TRAITE*".

2. La macro contenu dans CompterSi fait 5 actions divisées en 5 chapitres (C1 à C5, voir les commentaires) :

C1 : On ouvre le fichier OpérationSurQuittance et on extraie les références que l’application métier a gentiment collé avec les raisons sociales. Ces références sont insérées en colonne A, du même fichier.

C2 : On reviens ensuite chercher dans OpérationSurQuittance toutes informations (encaissements, dates, libellés, ...) liées à chaque référence qui se trouve dans mon portefeuille en colonne A. Ces informations sont recopiées dans l'onglet correspondant au mois en cours.

C3 : Dans cet onglet du mois en en cours, On mets au format chiffre les encaissements et une coloration particulière si la ligne est nouvelle.

C4 : On reviens dans notre Portefeuille et On Somme pour chaque référence le montant des encaissements trouvés dans l'onglet en cours.

C5 : Toujours dans notre Portefeuille, on compte le nombre d’occurrence dans les libellés de l'onglet en cours, pour chaque référence, à savoir : "*MOR*", "*ECH*", *"TRAITE*". Et je trie par ordre décroissant la colonne correspondant au mois en cours.

Vous l'aurez compris, c'est le chapitre 5 qui me bloque. En ne vous montrant que le chapitre 5, je vous ai perdu du temps et éloigné de la solution globale. Navré...

En conclusion : le Chapitre 5 ne peut écrire que sur les colonnes M à X du portefeuille.

Bonjour,

J'espère ne pas vous avoir perdu....

Bien à vous.

LG

Salut Genius,

pas encore...
Je regarde ça ce soir, sans doute.

A+

Ouf ! Quel soulagement. Merci C57.

Bonsoir,

Navré de relancer mais j'ai essayé toutes les combinaisons de mes maigres connaissances et jen viens au même résultat : Sumifs fait son travail mais juste avec une seule variable... Ou je passe par des Si et là j'ai des montants qui sont zappés ne sachant pas pourquoi.

A bout de force...

Cdt,

LG

Salut legénie,

fraudra patienter un peu : je fais un gros travail de correction pour ma fille qui me prend du temps.
Je reviens vers toi dès que possible...

A+

Ah ok, je comprends.

No problème C57.

Salutation a votre fille depuis le Gabon :-)

Salut Genius,

j'ai commencé à patauger dans ton code en me repérant à tes commentaires : un peu galère !
Tu m'excuseras d'avoir quelque peu bousculé ta manière de faire mais c'est le prix à payer pour, j'espère sans trop de couacs, te renvoyer ton fichier très vite.

A+