Déclenchement ListBox -

Oui je comprends. Si vous êtes ok, procédons par étapes.

Je me rends compte que le programme qui m'est demandé est plus complexe que prévu, j'avais mal cerné le problème au début.

Pour simplifier cette histoire de dates, je vous propose de faire une étape intermédiaire qui consiste à trier les 2 fichiers lors de leur ajout en cliquant sur les boutons load table avant de lancer le programme (la comparaison des dates sera plus simple par la suite)

1) Tableau_1

= > Surligner en jaune les lignes à comparer

cad pour chaque "CLIENT REFERENCE", les lignes dont le "CUM%" est le plus grand (Voir ex)

Supprimer les autres lignes

2) Tableau_2

=> Surligner en jaune les lignes à comparer

cad pour chaque "Document Client Reference", les lignes qui ont le plus grand "Revision Number" (Voir ex)

Supprimer les autres lignes

(Le tri croissant du fichier pour chaque Revision Number est déjà fait lors de l'ajout du doc. dans le ListBox_2 ou clic sur bouton dans l'esemple)

L'idée sera ensuite de comparer pour chaque référence les lignes jaunes (c'est a ce moment là que le problème sur les dates interviendra)

Merciii, heureusement pour moi que vous êtes la

Bonjour (c'est la dernière fois que je le précise - tu fais comme tu veux)

Banzai64 a écrit :

Tu prépares un fichier dans lequel tu indiques ce que tu choisis comme option et manuellement tu colorises la colonne date soit en rouge ou en vert en disant pourquoi

Si ce sont les mêmes fichiers ne les renvoies plus

Bjr, oui ce sont les mêmes fichiers.

Vous l'avez compris, mes fichiers de départ comportent des doublons (l'étape que je proposais juste avant était de simplifier les fichiers en supprimant les lignes qui ne sont pas intéressantes dans les 2 tableaux (j'avais simuler manuellement sur les P-J précédentes)).

Une fois ce tri fait, on compare les deux tableau avec les jeux couleurs suivant :

• Document : Présent (En vert), Manquant (En rouge), sans numéro (Gris)
• MSCode : Identique (En vert), Différent (En rouge), sans MSCode (Gris)

Venons-en aux dates (Explication dans le fichier Word ci-joint)

J'ai essayé d'être le plus clair possible

Merci

Bonjour

J'ai modifié le code de comparaison de date

C'est quoi un doublon dans le fichier ?

Dans le code je t'ai posé une question

Bjr,

J'essaie de répondre au mieux aux 2 questions

1)

If Not Cel Is Nothing Then
          Ligne = Cel.Row
          Depart = Cel.Address
          Kase.Interior.ColorIndex = 10  ' Vert
          Kase.Font.Color = vbBlack

          ' ??????????????????????????????????????????????????????????????????????????????????????????????????????
          ' C'est quoi absence de référence
          ' ??????????????????????????????????????????????????????????????????????????????????????????????????????
          'Absence de Référence
          If IsEmpty(Cel) Then
            Kase.Interior.ColorIndex = 15  ' Gris
            Kase.Font.Color = vbWhite
            Kase.Borders(xlDiagonalUp).LineStyle = xlContinuous
            Kase.Borders(xlDiagonalDown).LineStyle = xlContinuous
          End If

Le fichier a comparer est très grand. Pour certains documents, le numéro "CLIENT REFERENCE", colonne F est manquant, j'ai ainsi essayé d'écrire les lignes de codes ci-dessus pour mettre les cases en gris. (Voir image)

2)

J'ai modifié le code de comparaison de date

C'est quoi un doublon dans le fichier ?

Dans mes fichiers sources (Tableau_1 et 2), pour chaque numéro (CLIENT REFERENCE ou Document Client Reference) il y a souvent plusieurs lignes pour un seul numéros. J'appelle doublon les lignes qui ne m’intéressent pas (Celles qui sont en orange sur le doc word)

Tableau_1 : Garder pour chaque numéro la ligne qui a le plus grand CUM%

Tableau_2 : Garder pour chaque numéro la ligne qui a le plus grand Revision Number

Vous me suivez ?

Merci

Bonjour

Pour ta 1ère réponse je ne savais pas car dans le fichier que tu as posté toutes les lignes ont une référence

J'ai modifié le code à ce sujet

Les tableaux sont débarrassés des lignes inutiles ( à bien vérifier)

Bjr, doc bien reçut,

Je vais faire une série de test,

Merci encore pour votre aide précieuse

Bjr,

A priori ça fonctionne bien

J'ai simplement 1 interrogation :

Cette partie de code est-elle nécessaire du fait que le fichier soit trié avant ?

If Application.Subtotal(103, .Columns("F")) > 1 Then
      For Each Kase In .Range("F2:F" & NbLg).SpecialCells(xlCellTypeVisible)

        ' Absence de CLIENT REFERENCE
        If IsEmpty(Kase) Then
          Kase.Interior.ColorIndex = 15  ' Gris
          Kase.Borders(xlDiagonalUp).LineStyle = xlContinuous
          Kase.Borders(xlDiagonalDown).LineStyle = xlContinuous
        Else
          Set Cel = Sheets("Document").Columns("F").Find(what:=Kase, LookIn:=xlValues, lookat:=xlWhole)
          If Not Cel Is Nothing Then
            Ligne = Cel.Row
            Depart = Cel.Address
            Kase.Interior.ColorIndex = 10  ' Vert
            Kase.Font.Color = vbBlack

Do
              ' Prendre la dernière version si plusieurs Revision Number
              If Cel.Offset(0, -3) > Sheets("Document").Range("C" & Ligne) Then
                Ligne = Cel.Row
              End If
              Set Cel = Sheets("Document").Columns("F").FindNext(Cel)
            Loop While Depart <> Cel.Address 

Merci

Bonjour

Tu as fortement raison, normalement comme dans le fichier il ne reste que la ligne avec la valeur de révision la plus haute on peut s'affranchir de ce test

Pour en être vraiment sur, comme tu disposes de plus de fichier de données que moi, places un point d'arrêt sur la ligne surlignée

              ' Prendre la dernière version si plusieurs Revision Number
              If Cel.Offset(0, -3) > Sheets("Document").Range("C" & Ligne) Then
               Ligne = Cel.Row
              End If

et fais des tests

Si jamais il n'y a d'arrêt on pourra modifier le code

A toi de dire

Après plusieurs test, il n'y a pas d'arrêt sur cette ligne, c'est bon signe

Je peux ainsi supprimer le bloc ?

Bonjour

En principe , cela est fait dans cette version

A vérifier

Ok parfait,

Je dois attendre quelques jours pour faire des tests plus précis,

Je ne suis pas sur que le tri initial sur Tableau_1 soit fiable à 100%, je vous dirai si besoin d'aide

Merci bcp

Bjr,

J'ai testé la macro, c'est tout bon.

J'ai fais pas mal de modification mais je suis bloqué. J'ai besoin de modifier un peu la macro.

Lors de la comparaison des MSCode, au début nous comparions chaque lignes des 2 tableaux Si ok en vert, si non ok en rouge, code ci-dessous :

            If Kase.Offset(0, 8) <> Sheets("Document").Range("E" & Ligne) Then
              Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
              Kase.Offset(0, 8).Font.Color = vbBlack
              .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
              Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
            Else
              Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
              Kase.Offset(0, 8).Font.Color = vbBlack
            End If

J'aimerais maintenant complexifier.

Comparer MSCode selon :

• AFCE dans Tableau_2 avec IFCE , IFC1E..dans Tableau_1
• AFDE dans Tableau_2 avec IDDE, IDD1E..dans Tableau_1

Je pensais utiliser un Select Case

Ebauche code :

            Select Case Cel.Offset(0, -1)
              Case Is = "AFCE"
                  If Kase.Offset(0, 8) <> "IFCE" Or Kase.Offset(0, 8) <> "IFC1E" Or Kase.Offset(0, 8) <> "IFC2E" _
                    Or Kase.Offset(0, 8) <> "IFC3E" Or Kase.Offset(0, 8) <> "IFC4E" Or Kase.Offset(0, 8) <> "IFC5E" Then
                      Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
                      Kase.Offset(0, 8).Font.Color = vbBlack
                      .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                      Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
                  Else
                      Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
                      Kase.Offset(0, 8).Font.Color = vbBlack
                  End If

              Case Is = "AFDE"
                  If Kase.Offset(0, 8) <> "IDDE" Or Kase.Offset(0, 8) <> "IDD1E" Or Kase.Offset(0, 8) <> "IDD2E" Or Kase.Offset(0, 8) <> "IFDE" Then
                      Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
                      Kase.Offset(0, 8).Font.Color = vbBlack
                      .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                      Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
                  Else
                      Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
                      Kase.Offset(0, 8).Font.Color = vbBlack
                  End If
             End Select

Que pensez-vous de ma méthode ?

Avez-vous une idée de pk ça ne fonctionne pas ?

Merci bcp

Bonsoir

Ton programme plante dans la fonction "Function CelColOù(ByVal CelDéb As Range, ColQuoi, ByVal Opé As String, ByVal Valeur) As Range" avec les fichiers que j'ai

sinon la réponse que tu as eue sur l'autre forum ne te convient pas ?

Ça m'agace moyennement d'avoir déjà une réponse et d'en demander une autre

Bjr,

Problème résolut.

J'ai le droit de poser des questions sur plusieurs forum, je ne vois pas le problème.

Je te remercie vraiment de l'aide que tu m'as apporté pour la création de ce programme,

Cdt

Bonjour

Franchement ta demande auprès de plusieurs forum ne me gène pas

C'est que tu as obtenu une réponse qui te sied

Bjr,

Merci bcp pour vos rapides réponses !

J'ai une préférence pour celle de Dranreb, elle est plus compacte

Merci !!

Et tu viens en chercher une autre ici

Ce n'est ni sympa pour celui qui t'a répondu ni pour moi

Mais bon on ne vit pas dans un monde de bisounours