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 :
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 !!