Office 365 Besoin d'aide pour rechercher doublon et mettre en forme

Moreno076

XLDnaute Impliqué
Bonsoir à tous.

J'aurais besoin d'aide pour me faire une macro qui recherche les doublons de la colonne G dans l'onglet X3 et les insérer dans l'onglet Synthese en dessous de chaque référence en doublon et en ne conservant que certaines informations. Le plus simple est de joindre le fichier origine 60 et ce que je veux 61.

Je pense que c'est assez complexe à faire.

Merci
 

Fichiers joints

Moreno076

XLDnaute Impliqué
C'est bon ca fonctionne presque. Il me manque juste pour la colonne N une macro recopiant la case de la colonne M si c'est marqué < DOUBLON >. Si ce n'est pas marqué doublon, mais qu'il y a une date, rajouter la date avec un jour de plus, enfin si il n y a rien de marqué, indiqué Pas de date précise. Je pense que c'est plus simple. Merci pour votre aide
 

Fichiers joints

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Moreno,
Pourquoi une macro et pas une simple formule du genre en N2:
VB:
=SI(M2="";"Pas de date précise";SI(M2="< DOUBLON >";M2;M2+1))
Sinon en VBA, cela pourrait donner ça :
Code:
Sub DateReception()
    Taille = ThisWorkbook.Sheets("Synthèse").Range("A" & Cells.Rows.Count).End(xlUp).Row
    For i = 2 To Taille
        ValM = Range("M" & i)
        Select Case ValM
            Case ""
                Range("N" & i) = "Pas de date précise"
            Case "< DOUBLON >"
                Range("N" & i) = "< DOUBLON >"
            Case Else
                Range("N" & i) = ValM + 1
        End Select
    Next i
End Sub
Par contre je ne sais pas où vous voulez le placer. A vous de faire le Call.;)
 

Moreno076

XLDnaute Impliqué
Bonsoir Moreno,
Pourquoi une macro et pas une simple formule du genre en N2:
VB:
=SI(M2="";"Pas de date précise";SI(M2="< DOUBLON >";M2;M2+1))
Sinon en VBA, cela pourrait donner ça :
Code:
Sub DateReception()
    Taille = ThisWorkbook.Sheets("Synthèse").Range("A" & Cells.Rows.Count).End(xlUp).Row
    For i = 2 To Taille
        ValM = Range("M" & i)
        Select Case ValM
            Case ""
                Range("N" & i) = "Pas de date précise"
            Case "< DOUBLON >"
                Range("N" & i) = "< DOUBLON >"
            Case Else
                Range("N" & i) = ValM + 1
        End Select
    Next i
End Sub
Par contre je ne sais pas où vous voulez le placer. A vous de faire le Call.;)
Merci c'est impeccable, il me reste juste encore la colonne M la formule est =SI(A2="< DOUBLON >";"< DOUBLON >";"") C'est plus simple je trouve d'avoir des macros comme ça je n'ai aucune formule qui traine nulle part.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Si c'est un choix délibéré, rien à redire.:)
Pour la colonne M, on peut l'intégrer dans la même macro:
VB:
Sub DateReception()
    Taille = ThisWorkbook.Sheets("Synthèse").Range("A" & Cells.Rows.Count).End(xlUp).Row
    For i = 2 To Taille
        If Range("A" & i) = "< DOUBLON >" Then Range("M" & i) = "< DOUBLON >"
        ValM = Range("M" & i)
        Select Case ValM
            Case ""
                Range("N" & i) = "Pas de date précise"
            Case "< DOUBLON >"
                Range("N" & i) = "< DOUBLON >"
            Case Else
                Range("N" & i) = ValM + 1
        End Select
    Next i
End Sub
 

Moreno076

XLDnaute Impliqué
Impeccable c
Si c'est un choix délibéré, rien à redire.:)
Pour la colonne M, on peut l'intégrer dans la même macro:
VB:
Sub DateReception()
    Taille = ThisWorkbook.Sheets("Synthèse").Range("A" & Cells.Rows.Count).End(xlUp).Row
    For i = 2 To Taille
        If Range("A" & i) = "< DOUBLON >" Then Range("M" & i) = "< DOUBLON >"
        ValM = Range("M" & i)
        Select Case ValM
            Case ""
                Range("N" & i) = "Pas de date précise"
            Case "< DOUBLON >"
                Range("N" & i) = "< DOUBLON >"
            Case Else
                Range("N" & i) = ValM + 1
        End Select
    Next i
End Sub
Impeccable c est modifié
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,

Ah non, je ne suis pas d'accord. On ne jette jamais l'éponge. :)

En PJ, il suffit de mettre dans la feuille Synthèse :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 13 Then
        DateReception
    End If
End Sub
et à chaque fois que vous changerez une valeur dans la colonne M la colonne N se remettra à jour.:)

... mais vous pouvez le faire aussi en formules !
 

Fichiers joints

Moreno076

XLDnaute Impliqué
Bonjour,

Ah non, je ne suis pas d'accord. On ne jette jamais l'éponge. :)

En PJ, il suffit de mettre dans la feuille Synthèse :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 13 Then
        DateReception
    End If
End Sub
et à chaque fois que vous changerez une valeur dans la colonne M la colonne N se remettra à jour.:)

... mais vous pouvez le faire aussi en formules !
Fidèle au poste ou post lol Je viens de le rajouter mais ca me met un message d erreur peut etre du au changement depuis le dernier fichier
1582541290190.png
 

Fichiers joints

sylvanu

XLDnaute Barbatruc
Supporter XLD
Je ne suis pas parvenu à reproduire le défaut sauf si le fichier est vide.
Dans ce cas Taille=1 puis on fait for i=2 to 1 ! Dans ce cas il faut mettre une sécurité si Taille<2.

VB:
Sub DateReception()
    Taille = ThisWorkbook.Sheets("Synthèse").Range("A" & Cells.Rows.Count).End(xlUp).Row
    If Taille < 2 Then Exit Sub
    For i = 2 To Taille
        If Range("A" & i) = "< DOUBLON >" Then Range("M" & i) = "< DOUBLON >"
        ValM = Range("M" & i)
        Select Case ValM
            Case ""
                Range("N" & i) = "Pas de date précise"
            Case "< DOUBLON >"
                Range("N" & i) = "< DOUBLON >"
            Case Else
                Range("N" & i) = ValM + 1
        End Select
    Next i
End Sub
Etait ce dans ce cas que vous aviez le problème ?
 

Moreno076

XLDnaute Impliqué
Je ne suis pas parvenu à reproduire le défaut sauf si le fichier est vide.
Dans ce cas Taille=1 puis on fait for i=2 to 1 ! Dans ce cas il faut mettre une sécurité si Taille<2.

VB:
Sub DateReception()
    Taille = ThisWorkbook.Sheets("Synthèse").Range("A" & Cells.Rows.Count).End(xlUp).Row
    If Taille < 2 Then Exit Sub
    For i = 2 To Taille
        If Range("A" & i) = "< DOUBLON >" Then Range("M" & i) = "< DOUBLON >"
        ValM = Range("M" & i)
        Select Case ValM
            Case ""
                Range("N" & i) = "Pas de date précise"
            Case "< DOUBLON >"
                Range("N" & i) = "< DOUBLON >"
            Case Else
                Range("N" & i) = ValM + 1
        End Select
    Next i
End Sub
Etait ce dans ce cas que vous aviez le problème ?
Dans ce cas j'ai toujours l erreur 1582543221434.png
 

Fichiers joints

sylvanu

XLDnaute Barbatruc
Supporter XLD
Désolé, ça marche chez moi.
Ou alors je ne fais pas la bonne manip.
Fichier vierge, je rentre Envoyée en colonne A, sur même ligne en M je fais Ctrl . pour entrer la date et la macro met en N la date de demain.

... si ça continue il va falloir vous résoudre à mettre des formules.

Pouvez vous me dire exactement ce que vous faites avant que la macro plante ? et sur quelle ligne ?
Lors du plantage appuyez sur Débogage, la ligne incriminée va se mettre en jaune.
 

Moreno076

XLDnaute Impliqué
Désolé, ça marche chez moi.
Ou alors je ne fais pas la bonne manip.
Fichier vierge, je rentre Envoyée en colonne A, sur même ligne en M je fais Ctrl . pour entrer la date et la macro met en N la date de demain.

... si ça continue il va falloir vous résoudre à mettre des formules.

Pouvez vous me dire exactement ce que vous faites avant que la macro plante ? et sur quelle ligne ?
Lors du plantage appuyez sur Débogage, la ligne incriminée va se mettre en jaune.
A priori c'est au moment de Call Réception ca plante j'ai effectué les macros d'avant une par une. Je ne peux pas voir le message d erreur car ca plante mais si je fais une par une 1582550155911.png
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
1- Je crée une variable Public appelée Flag. ( Public pour être visible par tous. )
2- Dans WorsheetChange, je mets : If Flag = 0 Then Exit Sub
3- Dans "reception", je met au début Flag=0 et à la fin Flag=1
Donc WorsheetChange n'est active qui si elle n'est pas appelée par "reception".

C'est pour ça que je ne voyais rien, dans ma manip "reception" n'était surement jamais appelée.

J'ai lancé "reception" avec et sans sémaphore. L'erreur disparaît bien quand le flag est implémenté.

Testez pour voir.
 

Fichiers joints

sylvanu

XLDnaute Barbatruc
Supporter XLD
Ah au fait ! Je pense qu'à la fin de "reception", comme on a bloqué la mise à jour de la colonne N il faudrait relancer DateReception pour que la mise à jour soit complète, et de changer le commentaire Flag = 1 ' Autorisation et non Interdiction, ce qui ne voulait plus rien dire :
VB:
Sub reception()
Dim C As Range, Derlg As Long, Plage1 As Range, dteDate As Date, rngDate As Range, rngCode As Range
Application.ScreenUpdating = False
Flag = 0 ' Interdiction de modifier les valeurs par la macro Worksheet_Change.
....
...
End With
Application.ScreenUpdating = True
DateReception                     <<<<<<<<<<<<<<<<< A RAJOUTER
Flag = 1 ' Autorisation de modifier les valeurs par la macro Worksheet_Change.
End Sub
 

Fichiers joints

sylvanu

XLDnaute Barbatruc
Supporter XLD
Testez mon fichier. Est ce qu'il marche ?

Je viens de tester le votre en lançant "reception", et ça marche.
Il se plante toujours sur "reception" ? Dans ce cas faites du pas à pas.
 
Dernière édition:

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas