Comptage nombre d'occurence sur 2 critères sous VBA Fermé

Question

Hello à tous,

Voilà je débute pour le moment avec VBA, j'essaye en ce moment de faire tourner une macro qui va comptabiliser le nombre de fois où deux critères sont validés simultanément dans deux colonnes différentes. et fois le comptage terminé, une nouvelle ligne va être créee à la fin du tableau avec le nombre d'occurence indiqué.

Mon tableau a deux colonnes, Colonne A "Statut" et Colonne B "Merch" (pour Merchandiser).
Je veux compter par exemple le nombre de fois où le statut "GO MERCH" (Colonne A) est associé au merchandiser "ALEX" (Colonne B) :

Voilà ce que j'ai réussi à pondre, mais ça ne marche pas exactement comme prévu vu que le comptage à la fin ne s'affiche pas (problème de syntaxe je suppose) , vous pouvez m'aider, j'ai aussi l'impression que cette macro est un peu longue.

Sub recherche()
Dim col, lig, derlig, statut, merch, f1, f2, nombre
derlig = Range("A" & Application.Rows.Count).End(xlUp).Row
col = 2
nombre = 0

For lig = derlig To 50 Step -1
    For col = 1 To 2
        If Cells(lig, col) = "GO MERCH" Then f1 = True
        If Cells(lig, col) = "ALEX" Then f2 = True
    Next col
    If (f1 And f2) Then
    End If
    If (f1 And f2) Then nombre = nombre + 1
    f1 = False: f2 = False
Next lig
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.FormulaR1C1 = "GO MERCH = nombre"
    With ActiveCell.Characters(Start:=1, Length:=7).Font
        .Name = " Trebuchet MS"
        .FontStyle = "Regular"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16777216
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
End With

End Sub

Frenchie83 · Answer

Bonjour
Essayez ceci
Option Compare Text
Sub recherche()
    Dim lig, derlig, nombre
    derlig = Range("A" & Application.Rows.Count).End(xlUp).Row
    nombre = 0    
    For lig = derlig To 50 Step -1
        If Cells(lig, 1) = "GO MERCH" And Cells(lig, 2) = "ALEX" Then nombre = nombre + 1
    Next lig
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.FormulaR1C1 = "GO MERCH " & nombre
    With ActiveCell.Characters(Start:=1, Length:=7).Font
        .Name = " Trebuchet MS"
        .FontStyle = "Regular"
        .Size = 8
        .Underline = xlUnderlineStyleNone
        .Color = -16777216
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
End Subbonne journée
cdlt

Comptage nombre d'occurence sur 2 critères sous VBA

1 réponse

Discussions similaires

Newsletters