Comparaison variables avec 2 fichiers / Fonction InStr

Bonjour à tous,

Je vous adresse ce message aujourd'hui car j'ai une erreur sur mon programme que je ne comprends pas... je m'explique.

Je cherche à comparer dans 2 fichiers différents 3 variables situés dans :

Fichier 1 : Colonnes F (N° Doc), N(Code identification) & R(Date)

Fichier 2 : Colonnes F (N° Doc), E(Code identification) & I(Date)

• 1ère comparaison classique entre colonnes F & F OKAY
• 2ème comparaison entre colonnes N & E => avec un select casecar pour un code fichier 1 - correspond plusieurs codes du fichier 2
• 3ème comparaison classique entre colonnes R & I

Problème : Lors de la comparaison avec le select case... Dès que le programme match une ligne (Les 3 critères sont validés), au lieu de passer à la suivante, il passe au N° de doc suivant (il y a un seul numero de doc pour plusieurs code identification

Ci dessous mon code :

 If Application.Subtotal(103, .Columns("F")) > 1 Then
      For Each Kase In .Range("F2:F" & NbLg).SpecialCells(xlCellTypeVisible) 'Fichier 1
        Set Cel = Sheets("Document").Columns("F").Find(What:=Kase, LookIn:=xlValues, LookAt:=xlWhole) 'Fichier 2

          If Not Cel Is Nothing Then
            Ligne = Cel.Row
            Kase.Font.Color = vbBlack
            Kase.Interior.ColorIndex = 3  'Cases vides

            ' /!\ /!\ Gestion MSCode /!\ /!\
            Select Case Cel.Offset(0, -1)
              Case Is = "IFIE": Lst2 = "IIE|II1E|II2E|II3E|II4E"
              Case Is = "IFRE": Lst2 = "IFAE|IFRE|IFR1E|IFR2E|IFR3E"
              Case Is = "AFDE": Lst2 = "IDDE|IDD1E|IDD2E|IFDE|PIE"
              Case Is = "AFCE": Lst2 = "IFCE|IFC1E|IFC2E|IFC3E|IFC4E|IFC5E"
              Case Is = "IFHE": Lst2 = "IFHE"
              Case Is = "ASBE": Lst2 = "ASBE"
              Case Is = "ENQE": Lst2 = "IFQE"
              Case Is = "PURE": Lst2 = "IF1TE|IF2TE|IFPE|IFP1E|IFP2E|IFP3E"
              Case Is = "AFUE": Lst2 = "IFEE|IFE1E|IFE2E|IFE3E"
              Case Is = "CBTE": Lst2 = "START|FIN"
              Case Is = ""
              Case Else:        Lst2 = "…"
            End Select

            Kase.Offset(0, 8).Font.Color = vbBlack

            ' Test/Couleur feuille 1
            If Lst2 <> "…" Then
              If InStr(Cel, Kase.Value) Then
                If InStr(Lst2, Kase.Offset(0, 8).Value) Then
                  If (Kase.Offset(0, 12) - NbreJours <= Sheets("Document").Range("D" & Ligne)) And ((Kase.Offset(0, 12) + NbreJours) >= Sheets("Document").Range("D" & Ligne)) _
                        And Kase.Offset(0, 12).Interior.ColorIndex <> 15 Then
                            'Num
                            Kase.Interior.ColorIndex = 10 ' Vert
                            'MSCode
                            Kase.Offset(0, 8).Interior.ColorIndex = 10 ' Vert
                            'Date
                            Kase.Offset(0, 12).Interior.ColorIndex = 10 ' Vert
                  Else
                    Kase.Offset(0, 12).Interior.ColorIndex = 3: End If
                Else
                  Kase.Offset(0, 8).Interior.ColorIndex = 3: End If
              Else
                Kase.Interior.ColorIndex = 3: End If
            End If
          End If
      Next Kase
    End If

J'ai un problème avec l'utilisation du select case dans ma comparaison puisqu'il fonctionne que pour la première ligne de comparaison d'un Numero de doc avec un code identification au lieux de fonctionner pour toutes les lignes....

J'espère que vous pouvez m'aider car je suis vraiment perdu

Merci à tous pour le temps accordé à essayer de résoudre mon problème

Je viens de voir que la fonction que j'utilise :

InStr, fonction

permet de :

Renvoie la position de la première occurrence d'une chaîne à l'intérieur d'une autre.

Connaissez-vous une fonction qui permette de faire la comparaison pour toutes les valeurs d'une chaine dans une autre ?

Merci, merci !!

Bonjour

Une idée mais pas sur à 100%

Modifies la partie correspondante

        ' Test/Couleur feuille 1
Dim I As Integer, Ok As Boolean, Tablo
        If lst2 <> "…" Then
          If InStr(Cel, Kase.Value) Then
            Tablo = Split(lst2, "|")
           Ok = False
            For I = 0 To UBound(Tablo)
             If InStr(Tablo(I), Kase.Offset(0, 8).Value) Then Ok = True: Exit For
           Next I
           If Ok = True Then
            'If InStr(lst2, Kase.Offset(0, 8).Value) Then
              If (Kase.Offset(0, 12) - NbreJours <= Sheets("Document").Range("D" & Ligne)) And ((Kase.Offset(0, 12) + NbreJours) >= Sheets("Document").Range("D" & Ligne)) _

Si pas ça joins un fichier en indiquant les opérations à faire

Bonjour Banzai64,

Merci une fois de plus pour ta réponse.. c'est plus ton code que le mien au final...

La macro a très bien fonctionnée mais on m'a demandé de faire la modification suivante (explication doc word en p-J)

A priori le code que tu viens de proposer ne fonctionne pas

Merci pour ton aide précieuse

Bonjour

Le problème vient que la fonction Find retourne la première valeur qu'elle trouve

Donc elle retournait toujours la même ligne

Une solution : Une fois la ligne retournée on efface la cellule

Modifies le code

          Cel = ""
          End If
      Next Kase

Entendu,

Je vais tester avec attention ta solution pour mon problème,

1000 merci !

Je viens de faire une série de tests,

Si je comprends bien, avec l'ajout du Cel = "", le fonction FIND fonctionne mieux mais en supprimant les ligne de tableau 2

Si la fonction supprime la ligne pour fonctionner, la colonne dans tableau 2 devrait devenir vide après exécution de la macro mais ce n'est pas le cas, j'ai l'impression que la macro scanne que la moitiée des lignes, es-ce la cas ? Avez-vous une idée ?

Je suis content du résultat (ok pour qq tests je vais pousser l'analyse demain matin) mais je suis étonnée que dans tableau 2, toutes les lignes ne soit pas supprimée après éxécution de la macro

Si vous avez des idées/conseils

Mercii

Bonjour

A chaque fois que la fonction Find trouve une occurrence, celle-ci sera effacée après vérification du contenu des autres cellules

Il y avait une erreur

Il ne fallait pas la variable NbLg en globale

Testes ce fichier

Je viens de comprendre la modification,

Les tests sont très positifs pour le moment

Merci !!