XL 2016 VBA : recherche 2 critères

Phillip · 30 Juin 2021

Bonjour,

Je n'ai pas trouvé sur le forum une réponse qui pourrait s'adapter à ce que je cherche à faire en VBA.

Dans le petit fichier joint, j'ai une série de matches de badminton et le numéro de match.

Tour 1 Paul a joué contre Alain
Tour 2 Pierre a joué contre Simon
etc...
Mais aussi, pour le Tour 1 Lise a joué contre Jeanne, et Albert contre Phil.

Payul a rejoué au tour 6 contre Albert, etc...

Je voudrais pour le tour 1 ET Paul trouver Résultat1 (sachant que au tour 1 il n'y a pas que Paul qui a joué. J'ai tenté des find, mais je n'arrive pas à mettre plusieurs critères...

Mon code pourrait ressembler à ça

VB:

For chaquejoueur
    for i = 1 to 10 'dix tours'
    'trouver tour 1 ET Paul dans les range adéquats
    'Afficher le résultat en Gi par exemple (pour Paul)
    next i


next joueur 'après paul, on passe à Pierre etc...'

Merci de votre aide

Cordialement

Phillip

Compte Supprimé 979 · 30 Juin 2021

Bonsoir Phillip,

Pourquoi ne pas utiliser une formule

VB:

=SIERREUR(INDEX(D$1:D$12;SOMMEPROD((A$1:A$12=G1)*(B$1:B$12=F1)*LIGNE(B$1:B$12));0);SIERREUR(INDEX(D$1:D$12;SOMMEPROD((A$1:A$12=G1)*(C$1:C$12=F1)*LIGNE(B$1:B$12));0);""))

@+

laurent950 · 30 Juin 2021

Bonsoir @Phillip

Exemple Simple avec Choix du Tour :
Ligne de choix = For j = 1 To 1 ' Exemple pour le Tours N°1'
Ligne de choix = For j = 1 To 3 ' Exemple pour le Tours N°1 Au N°3'

VB:

For i = 1 To 12
    For j = 1 To 1 ' Exemple pour le Tours N°1'
        If CInt(Cells(i, 1)) = CInt(j) Then
        'trouver tour 1 ET Paul dans les range adéquats
            Cells(i, 7) = Cells(i, 2) & " - " & Cells(i, 4)
        'Afficher le résultat en Gi par exemple (pour Paul)
        End If
    Next j ' Pour chaque tour
Next i ' après paul, on passe à Pierre etc...'

Exemple Complexe avec Choix des Tours :
Dim Tours As Variant
Tours = Array("1", "3", "6")
Ligne de choix = For j = LBound(Tours) To UBound(Tours) 'Pour Tours 1 / 3 / 6
Ou
Dim Tours As Variant
Tours = Array("2", "4", "6")
Ligne de choix = For j = LBound(Tours) To UBound(Tours) 'Pour Tours 2 / 4 / 6

Code:

' A Adapter ci-dessous : (Exemple)
' Si on veux le Tour 1 et 3 et 6 Alors on passe en Array :
  Dim Tours As Variant
  Tours = Array("1", "3", "6")
'  For j = LBound(Tours) To UBound(Tours) 'Pour Tours 1 / 3 / 6

For i = 1 To 12
    For j = LBound(Tours) To UBound(Tours) 'Pour Tours 1 / 3 / 6
        If CInt(Cells(i, 1)) = CInt(Tours(j)) Then
        'trouver tour 1 ET Paul dans les range adéquats
            Cells(i, 7) = Cells(i, 2) & " - " & Cells(i, 4)
        'Afficher le résultat en Gi par exemple (pour Paul)
        End If
    Next j ' Pour chaque tour
Next i ' après paul, on passe à Pierre etc...'

C'est la Solution ?

Phillip · 30 Juin 2021

Bonjour Bruno et Laurent,

merci pour ces 2 solutions que j'essaye de ce pas. Je vous tiens au courant !

Cordialement

Phillip

Phillip · 1 Juillet 2021

Rebonjour,

Alors j'ai testé la formule qui a l'air de marcher mais qui est fort longue. J'ai en plus des conditions à mettre dans mon vrai fichier, alors j'ai peur de me mélange les pinceaux.

Pour la macro ça me donne ce que j'ai surligné en jaune dans la copie d'écran, alors que je voudrais quelque chose comme ce qui est surligné en vert...

Et on voit bien que sur le fichier xlm joint, ça ne marche pas...

Merci

Cordialement

Phillip

laurent950 · 1 Juillet 2021

Bonsoir @Phillip ,

VB:

Sub testV()

For h = 1 To 12
    For i = 1 To 4 '4 joueurs
        If Cells(h, 2) = Cells(i + 1, 6) Then
            For j = 1 To 6 ' 6 tours'
                If CInt(Cells(h, 1)) = CInt(j) Then
                'trouver tour 1 ET Paul dans les range adéquats
                    Cells(i + 1, j + 6) = Cells(h, 4)
                'Afficher le résultat en Gi par exemple (pour Paul)
                End If
            Next j ' Pour chaque tour
        End If
    Next i ' après paul, on passe à Pierre etc...'
Next h

End Sub

Phillip · 2 Juillet 2021

Bonjour,

Comme je le disais dans un autre post, j'ai finalement trouvé une solution...

Merci à tous de vos efforts ! Si je n'ai pas pris vos codes, ils m'ont sans doute inspirés pour le mien qui fait ce que je veux !

Cordialement

Phillip

Compte Supprimé 979 · 2 Juillet 2021

Bonjour,

Un forum d'entraide est là pour donner mais aussi avoir les solutions

Il serait donc fort agréable d'avoir la vôtre SVP

@+

Phillip · 2 Juillet 2021

Pardon...Je l'ai donnée sur un autre post mais pas dans celui-ci...Mille excuses...

Mon problème en fait était de chercher des données sur plusieurs critères dans plusieurs zones. J'ai résolu le problème en définissant des zone de recherches où mon critère n°1 était respecté. Peut - être que ça n'est pas clair dit comme ça, voir le code et le fichier joint !

Merci à tous en tous cas !

VB:

Sub SeriesparEquipe()

Application.ScreenUpdating = False

'Je commence par trier par journée
'======================================================================================================================
Range("A2:H381").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("A2:A381") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A2:H381")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("A1").Select

'======================================================================================================================

Set equipes = Range("I5:I24")




For Each equipe In equipes
coljournee = Cells(5, 10).Column
    For zonejournees = 1 To 380 Step 10
 'Ici je définis la zone qui concerne la journée. C'était mon problème initial : comment trouver les matches de la journée 1, 2, X....       
    
    
    Set matches = Range(Cells(zonejournees + 1, 2), Cells(zonejournees + 10, 5))
    
matches.Select
    'Je trouve la ligne et la colonne de l'equipe a la premiere journee
    
    ligneequipe = matches.Find(what:=equipe).Row
        
    colonneEquipe = matches.Find(what:=equipe).Column
    
        If colonneEquipe = 2 Then
            If Cells(ligneequipe, colonneEquipe + 4) = "" Then
            Cells(equipe.Row, coljournee).Value = ""
            ElseIf Cells(ligneequipe, colonneEquipe + 4) > Cells(ligneequipe, colonneEquipe + 5) Then
            Cells(equipe.Row, coljournee).Value = "V"
            ElseIf Cells(ligneequipe, colonneEquipe + 4) = Cells(ligneequipe, colonneEquipe + 5) Then
            Cells(equipe.Row, coljournee).Value = "N"
            Else: Cells(equipe.Row, coljournee).Value = "D"
            End If
        End If

         If colonneEquipe = 5 Then
            If Cells(ligneequipe, colonneEquipe + 2) = "" Then
            Cells(equipe.Row, coljournee).Value = ""
            ElseIf Cells(ligneequipe, colonneEquipe + 2) > Cells(ligneequipe, colonneEquipe + 1) Then
            Cells(equipe.Row, coljournee).Value = "V"
            ElseIf Cells(ligneequipe, colonneEquipe + 2) = Cells(ligneequipe, colonneEquipe + 1) Then
            Cells(equipe.Row, coljournee).Value = "N"
            Else: Cells(equipe.Row, coljournee).Value = "D"
            End If
         End If
        
    coljournee = coljournee + 1
      
    Next zonejournees
    
    
Next equipe
    


End Sub

XL 2016 VBA : recherche 2 critères

Phillip

XLDnaute Occasionnel

Pièces jointes

Compte Supprimé 979

Guest

laurent950

XLDnaute Barbatruc

Phillip

XLDnaute Occasionnel

Phillip

XLDnaute Occasionnel

Pièces jointes

laurent950

XLDnaute Barbatruc

Phillip

XLDnaute Occasionnel

Compte Supprimé 979

Guest

Phillip

XLDnaute Occasionnel

Pièces jointes

Discussions similaires