Besoin d'aide pour un développement de macro VB pour comparaison de données entre 2 tableaux excel

[GPonsan]

Bonjour,

J'essaie depuis quelques jours de trouver un moyen de "mécaniser" la comparaison de données entre 2 tableaux excel presuqe identique, car extrait de la même source, mais à 2 dates différentes.

La problématique est la suivante:
Chaque semaine (le jeudi) la logistique me fourni un planning contenant différentes informations, notamment un numéro d'ordre unique (colonne K) et une date de livraison (colonne G). Ce tableau est généré automatiquement par notre logiciel interne de gestion (voir PJ)
Pour des raisons d'optimisation de la production, je souhaite pouvoir vérifier en ouvrant le tableau de la semaine S en cours, si les dates de livraison ont changé entre le tableau de la semaine S-4 et celui de la semaine S.
Si il n y'a pas eu de changement, indiquer "ok" ou "X" dans le tableau de la semaine S, colonne BT, en face du numéro d’ordre correspondant; Ceci me permettant de valider un bonus de location.

Une règle quasi identique sera crée en analysant la tableau S-3, S-2 et S-1, mais ne changeant le critère de comparaison

Les tableaux "b07 Sxx.xls" sont stockés sur mon disque dur interne, je sais les appeler par macro, créer les noms de colonnes à remplir dans le tableau Semaine S, et créer un tableau "local" (array?) stockant les valeurs à comparer.

Par contre je bloque sur la comparaison des dits tableaux, je pense à cause du fait que la plupart des N° ordre présent en Semaine S sont absent en semaine S-4, et de la présence de cellules vides.

Le but n'est pas de me créer l'ensemble des 4 règles pour l'analyse des S-4 à S-1, mais de m'accompagner pour l'analyse et comparaison entre S et S-4, que je puisse le dupliquer aux autres.

Si il faut plus de précisions, n'hésitez pas,

Merci d'avance

Guillaume P
-----

[GPonsan]

Après multiples essais, je pense avoir trouvé en fouillant sur les forums une façon de traiter mon problème. Mais j'ai toujours une erreur au moment de la définition de wsa et wsb, un blocage avec erreur 9 "l'indice n'appartient pas à la sélection"

Si une âme charitable passe par la et peut me débloquer, ça serait extrêmement appréciable.

Sub Calcul_Bonus_Malus()

'Démarrage mode MACRO
    Application.StatusBar = "Macro Running"

'Choix de la semaine à utiliser pour le calcul Bonu/Malus
    Dim sem As String
    sem = InputBox("N° de semaine pour laquelle établir le Bonus/Malus ?", "Calcul Bonus/Malus")
   'La variable reçoit la valeur entrée dans l'InputBox
   
'Création des noms et emplacements de fichiers historiques à utiliser
'Emplacement à respecter ou changer : "D:\Data\BY CN MTL\Production\Planning B07\"
    
        semB10j = sem - 4
        semB5j = sem - 3
        semM5j = sem - 2
        semM10J = sem - 1
        
        fichierS4 = "D:\Data\BY CN MTL\Production\Planning B07\b07 S" & semB10j & ".xls"
        fichierS3 = "D:\Data\BY CN MTL\Production\Planning B07\b07 S" & semB5j & ".xls"
        fichierS2 = "D:\Data\BY CN MTL\Production\Planning B07\b07 S" & semM5j & ".xls"
        fichierS1 = "D:\Data\BY CN MTL\Production\Planning B07\b07 S" & semM10J & ".xls"
        fichierS = "D:\Data\BY CN MTL\Production\Planning B07\b07 S" & sem & ".xls"

' Définition des classeurs et feuilles à comparer

Dim wsa, wsb

    Application.Workbooks.Open (fichierS)
    Application.Workbooks.Open (fichierS4)
    wsa = Workbooks(fichierS).Sheets("planning général détaillé")
    wsb = Workbooks(fichierS4).Sheets("planning général détaillé")
    
' i est un pointeur de ligne, et on boucle sur les lignes du classseur A la colonne J
i = 1
While wsa.Cells(I, 10) <> ""
'on recherche dans le classeur B, le nom trouvé en colonne J dans le classeur A
Set rp = wsb.Range("J:J").Find(wsa.Cells(I, 10))

If Not (rp Is Nothing) Then
 'on a trouvé le nom dans le classeur B on copie les colonnes D à B dans le classeur A
        wsb.Range("G" & rp.Row).Copy
        wsa.Range("BX" & I).Paste
End If
'on passe à la ligne suivante
i = i + 1
Wend

'On bascule dans le classeur A, fichier "Semaine S" pour analyse des données copiées
wsa.Save
wsa.Activate

'Création colonnes B/M

    Range("BT16") = "Bonus -10J"
    
'On compare lignes à lignes les valeurs des colonnes BX et G, en écartant les valeurs vides

For j = 18 To 30

While wsa.Cells(j, "G") <> "" And wsa.Cells(j, "BX") <> ""

If Cells(j, "G") = Cells(j, "BX") Then
        Range(j, "BT") = "X"
End If
'on passe à la ligne suivante
j = j + 1

Wend

wsa.Save

    'On affiche fin dans la cellule BU11
    Range("BU11") = "Fin"
    
    'Arrêt mode MACRO
    Application.StatusBar = ""
    

End Sub

[Optimix]

Je vois pas mal de choses à revoir dans votre code :
- si vous arrivez à le faire tourner et s'il ne plante pas à hauteur de la ligne semB10j = sem - 4 c'est que vous n'utilisez pas l'option "Outil...Option" Déclaration obligatoire des variables. C'est très dangereux ; je me demande depuis VB 2.0 pourquoi Microsoft en a fait une option.
- votre code est mal indenté. La structure n'est pas claire et il faut faire de gros efforts pour comprendre ce que vous voulez faire
- mieux vaut regrouper toutes les déclaration de variable (Dim...) en tête de procédure ou de fonction, ç'est plus pratique que de les déclarer au fur et à mesure du besoin
- enfin une grosse erreur de typage quand vous écrivez :

    
    Dim sem As String
    sem = InputBox("N° de semaine pour laquelle établir le Bonus/Malus ?", "Calcul Bonus/Malus")
    ....
    semB10j = sem - 4

La variable semB10j n'a pas été déclarée, ne peut être qu'un entier. Vous n'avez pas le droit de faire une soustraction entre une chaîne de caractère et un entier. Il faut écrire :

    Dim sem as integer, semB10j  as integer
    sem = InputBox("N° de semaine pour laquelle établir le Bonus/Malus ?", "Calcul Bonus/Malus")
    ....
    semB10j = sem - 4

[GPonsan]

Bonjour,

Merci pour votre réponse, à force de recherches sur divers sites et d'essais, j'ai fini par arriver à le faire tourner, et à lui faire faire ce que je souhaite !

Maintenant tant qu'à y être, autant aller jusqu'au bout et essayer d'avoir quelque chose de "propre" en termes de codage, j'ai donc essayé d'appliquer vos conseils concernant les déclarations et l'organisation général. Cela correspond t'il un peu plus aux standards ? Ca reste relativement redondant, j'ai raisonné en termes de "je le fais une fois" puis je reproduis en changeant mes critère de comparaison.

Pour le reste j'étais parti au début sur une solution par remplissage de tableaux locaux, au lieu de bêtement recopier de feuilles à feuilles. Mais je restais bloqué sur la comparaison entre une valeur contenue dans un tableau "local" et une valeur contenue dans une feuille.

Si vous pensez à une autre façon de traiter le sujet ou d'optimiser, ça m'amuserais de regarder. après si vous avez d'autres remarques n'hésitez pas !

Merci encore,

Guillaume

Sub Calcul_Bonus_Malus()

'Début chronomètre
Dim debut As Date, temps As Date, fin As Date
debut = Time

'Démarrage mode MACRO
    Application.StatusBar = "Macro Running"
    
'Déclaration de variables
    Dim sem, semB10j, semB5j, semM5j, semM10j As Integer
    Dim i, j As Integer
    Dim S5, S4, S2, S1, S0 As String
    Dim wbs0, wbs1, wbs2, wbs4, wbs5 As Workbook
    Dim wss0, wss1, wss2, wss4, wss5 As Worksheet
    Dim nligne1, nligne2, nligne4, nligne5 As Integer
    
'Choix de la semaine à utiliser pour le calcul Bonus/Malus
    
    sem = InputBox("N° de semaine pour laquelle établir le Bonus/Malus ?", "Calcul Bonus/Malus")
   
'Création des noms et emplacements de fichiers historiques à utiliser
'Emplacement à respecter ou changer : "D:\Data\BY CN MTL\Production\Planning B07\"
    
        semB10j = sem - 5
        semB5j = sem - 4
        semM5j = sem - 2
        semM10j = sem - 1
           
        S5 = "D:\Data\BY CN MTL\Production\Planning B07\b07 S" & semB10j & ".xls"
        S4 = "D:\Data\BY CN MTL\Production\Planning B07\b07 S" & semB5j & ".xls"
        S2 = "D:\Data\BY CN MTL\Production\Planning B07\b07 S" & semM5j & ".xls"
        S1 = "D:\Data\BY CN MTL\Production\Planning B07\b07 S" & semM10j & ".xls"
        S0 = "D:\Data\BY CN MTL\Production\Planning B07\b07 S" & sem & ".xls"

'Affectation des feuilles et classeurs à utiliser

    Set wbs0 = Workbooks.Open(S0)
    Set wbs1 = Workbooks.Open(S1)
    Set wbs2 = Workbooks.Open(S2)
    Set wbs4 = Workbooks.Open(S4)
    Set wbs5 = Workbooks.Open(S5)
    
    Set wss0 = wbs0.Worksheets("planning général détaillé")
    Set wss1 = wbs1.Worksheets("planning général détaillé")
    Set wss2 = wbs2.Worksheets("planning général détaillé")
    Set wss4 = wbs4.Worksheets("planning général détaillé")
    Set wss5 = wbs5.Worksheets("planning général détaillé")
    
    nligne1 = wss1.Columns(10).Find("*", , , , xlByColumns, xlPrevious).Row
    nligne2 = wss2.Columns(10).Find("*", , , , xlByColumns, xlPrevious).Row
    nligne4 = wss4.Columns(10).Find("*", , , , xlByColumns, xlPrevious).Row
    nligne5 = wss5.Columns(10).Find("*", , , , xlByColumns, xlPrevious).Row

'Création colonnes Bonus/Malus
    wss0.Range("BT16") = "Bonus -10J"
    wss0.Range("BU16") = "Bonus -5J"
    wss0.Range("BV16") = "Malus +5J"
    wss0.Range("BW16") = "Malus +10J"
    
'Bonus_10J Macro
'   On boucle sur les lignes du classseur A la colonne J
'   On recherche dans le classeur B en colonne J, le nom trouvé en colonne J dans le classeur A

For i = 1 To nligne5
    If wss0.Cells(i, 10) <> "" Then
        Set rp = wss5.Range("J:J").Find(wss0.Cells(i, 10))
            If Not (rp Is Nothing) Then
                wss5.Range("G" & rp.Row).Copy
                wss0.Range("BX" & i).PasteSpecial Paste:=xlPasteValues
            End If
    End If
Next i

'Bonus_5J Macro
'   on boucle sur les lignes du classseur A la colonne J
'   on recherche dans le classeur B en colonne J, le nom trouvé en colonne J dans le classeur A

For i = 1 To nligne4
    If wss0.Cells(i, 10) <> "" Then
        Set rp = wss4.Range("J:J").Find(wss0.Cells(i, 10))
            If Not (rp Is Nothing) Then
                wss4.Range("G" & rp.Row).Copy
                wss0.Range("BY" & i).PasteSpecial Paste:=xlPasteValues
            End If
    End If
Next i

'Malus_5J Macro
'   on boucle sur les lignes du classseur A la colonne K
'   on recherche dans le classeur B en colonne K, le nom trouvé en colonne K dans le classeur A

For i = 1 To nligne2
    If wss0.Cells(i, 11) <> "" Then
        Set rp = wss2.Range("K:K").Find(wss0.Cells(i, 11)) 'N° ordre identique entre Semaine S et Semaine S-2
            If Not (rp Is Nothing) Then
                wss2.Range("BS" & rp.Row).Copy
                wss0.Range("BZ" & i).PasteSpecial Paste:=xlPasteValues
            End If
    End If
Next i

For i = 1 To nligne2
    If wss0.Cells(i, 10) <> "" Then
        Set rq = wss2.Range("J:J").Find(wss0.Cells(i, 10)) 'N° opération existant entre Semaine S et Semaine S-2
            If (rq Is Nothing) Then
                wss0.Range("BV" & i) = "X"
            End If
    End If
Next i

'Malus_10J Macro
'   on boucle sur les lignes du classseur A la colonne J
'   on recherche dans le classeur B en colonne J, le nom trouvé en colonne J dans le classeur A

For i = 1 To nligne1
    If wss0.Cells(i, 11) <> "" Then
        Set rp = wss1.Range("K:K").Find(wss0.Cells(i, 11)) 'N° ordre identique entre Semaine S et Semaine S-2
            If Not (rp Is Nothing) Then
                    wss1.Range("BS" & rp.Row).Copy
                    wss0.Range("CA" & i).PasteSpecial Paste:=xlPasteValues
                    wss1.Range("G" & rp.Row).Copy
                    wss0.Range("CB" & i).PasteSpecial Paste:=xlPasteValues
                Else
                    wss0.Range("BW" & i) = "X"
            End If
    End If
Next i

'On ferme les fichiers qui ne seront plus utilisés
    wbs5.Close
    wbs4.Close
    wbs2.Close
    wbs1.Close
    
'On analyse les données extraites des tableaux S-5 à S-1, pour remplissage des colonnes Bonus/Malus"
'Bonus 10J : On compare lignes à lignes les valeurs des colonnes BX et G, en écartant les valeurs vides, pour vérifier si changement de date de livraison
For j = 18 To 80
    If wss0.Cells(j, "G") <> "" And wss0.Cells(j, "BX") <> "" Then
        If wss0.Cells(j, "G") = wss0.Cells(j, "BX") Then
            wss0.Cells(j, "BT") = "X"
        End If
    End If
Next j

'Bonus 5J : On compare lignes à lignes les valeurs des colonnes BY et G, en écartant les valeurs vides, pour vérifier si changement de date de livraison
For j = 18 To 80
    If wss0.Cells(j, "G") <> "" And wss0.Cells(j, "BY") <> "" Then
        If wss0.Cells(j, "G") = wss0.Cells(j, "BY") Then
            wss0.Cells(j, "BU") = "X"
        End If
    End If
Next j

'Malus 5J :On compare lignes à lignes les valeurs des colonnes BZ et G, en écartant les valeurs vides, pour vérifier si changement de quantité
For j = 18 To 80
    If wss0.Cells(j, "BS") <> "" And wss0.Cells(j, "BZ") <> "" Then
        If wss0.Cells(j, "BS") <> wss0.Cells(j, "BZ") Then
           wss0.Cells(j, "BV") = "X"
        End If
    End If
Next j

'Malus 10J :On compare lignes à lignes les valeurs des colonnes BS avec CA et G avec CB , en écartant les valeurs vides, pour vérifier si changement de quantité, et on impute malus si valeurs "N° ordre" ou "N) Ope" nulle
For j = 18 To 80
    If wss0.Cells(j, "J") = "" Or wss0.Cells(j, "K") = "" Then
        wss0.Cells(j, "BW") = "X"
    End If
        If wss0.Cells(j, "BS") <> "" And wss0.Cells(j, "CA") <> "" Then
            If wss0.Cells(j, "BS") <> wss0.Cells(j, "CA") Or wss0.Cells(j, "G") <> wss0.Cells(j, "CB") Then
                wss0.Cells(j, "BW") = "X"
            End If
        End If
Next j

'On efface les valeurs stockées dans les colonnes "BX" à "CB"
    wss0.Columns("BX:CB").Delete

'On sauvegarde l'état du tableau Semaine S
    wbs0.Save

'On affiche fin dans la cellule BU11
    MsgBox ("Fin d'éxécution de la macro")
    
'Arrêt mode MACRO
    Application.StatusBar = ""
    
'Arrêt chrono et affichage temps
    fin = Time
    temps = fin - debut
    MsgBox ("C'est fini !" & Chr(10) & "temps de traitement " & temps)
    
End Sub

[A voir en vidéo sur Futura]

[Optimix]

Permettez-moi d'émettre quelques réserves.
Vos variables Range rp et rq ne sont toujours pas déclarées ce qui veut dire que vous n'êtes pas allé dans Outils...Options...et que vous n'avez pas coché l'option "Déclaration des variables obligatoires".
De plus, dans votre code vous écrivez

Set wss0 = wbs0.Worksheets("planning général détaillé")

. Or votre onglet a pour nom "Planning général détaillé" avec un P majuscule. En principe, vous devriez avoir une erreur 9 (indice n'appartenant pas à la sélection).
Enfin, il me manque tout un tas de fichiers pour pouvoir tester votre code.

Pour l'indentation, c'est nettement plus digeste. Encore quelques détails et vous serez bon.
Par exemple, au lieu de :

For i = 1 To nligne5
    If wss0.Cells(i, 10) <> "" Then
        Set rp = wss5.Range("J:J").Find(wss0.Cells(i, 10))
            If Not (rp Is Nothing) Then
                wss5.Range("G" & rp.Row).Copy
                wss0.Range("BX" & i).PasteSpecial Paste:=xlPasteValues
            End If
    End If
Next i

...pourquoi ne pas écrire :

For i = 1 To nligne5
    If wss0.Cells(i, 10) <> "" Then
        Set rp = wss5.Range("J:J").Find(wss0.Cells(i, 10))
        If Not (rp Is Nothing) Then
            wss5.Range("G" & rp.Row).Copy
            wss0.Range("BX" & i).PasteSpecial Paste:=xlPasteValues
        End If
    End If
Next i

C'est un détail, mais...