Macro pour repositionner des valeurs sur la bonne ligne

Le 24/01/2025 à 15:15

Bonjour,

J'ai besoin d'un petit coup de pouce SVP.

J'ai une base fixe de produits alimentaires "Mercuriale initiale" en colonne BCD avec un numéro de lot en colonne B

J'importe une nouvelle base de produits alimentaires "nouvelle mercuriale" en colonne FGH avec le numéro de lot en colonne F

Je souhaiterais un tri de la "nouvelle mercuriale" (FGH) de facon à repositionner les numéros de lot identiques sur la meme ligne que la "mercuriale initiale"(BCD)

Si le numéro de lot de la "nouvelle mercuriale" (FGH) ne correspond à aucune valeur de la "mercuriale initiale"(BCD), alors déplacer la ligne de la colonne FGH dans la première ligne vide de la colonne FGH.

Merci d'avance pour votre aide

17test-mercuriale.xlsx (22.04 Ko)
Le 24/01/2025 à 15:27

Bonjour,

Je vais peut être dire une bétise mais ayant vu que les produits de la première mercuriale étaient classés par ordre croisant en ce qui concerne leur numéro de lot, j'ai donc sélectionné les cellules (F3:H172) et ai demandé un tri par classement croissant, et sauf erreur de ma part j'ai obtenu un classement qui selon moi correspond à ta demande
Est ce bien cela que tu désires ?

Le 24/01/2025 à 18:17

Bonjour Jacky,

Merci Jacky pour ton observation. Ce n'est pas uniquement un tri à réaliser. Pour cette exemple, la liste de nombres est identique mais ce n 'est pas toujours le cas Je vais essayer d'etre plus précis

Par exemple une macro qui démarre de la cellule B1 puis elle recherche cette valeur dans la colonne F.

si la valeur est trouvé en F2: alors je selectionne F2+G2+H2, couper et coller ces valeurs en F1 ( Cellule trouvé dans colonne F, on copie les 2 cellules à droite) et sans supprimer les valeurs si F1 n'est pas vide.

Si valeur non trouvé : Je descends la valeur de la colonne F à la premiere ligne vide.

Le 24/01/2025 à 18:39

Bonjour diabolo162, Jacky 🙂

En fait, tu veux aligner tes données en te basant sur le n• de lot.

S'il n'y a pas de correspondances , on repousse les lignes en bas de tableau.

Dans ce cas, tu peux utiliser un dictionnaire, voire 2 boucles imbriquées pour tester les correspondances et procéder à l'alignement.

Tu alimentes une variable tableau des non-correspondances via un "ReDim Preserve" que tu restitues à la suite des correspondances.

Tout ça de mon téléphone portable 😛

klin89

Le 24/01/2025 à 20:23

Merci Klin pour la reformulation. Je pense que tu as bien cerné ma demande

Le 24/01/2025 à 22:51

re,

J'ai une proposition à te faire, elle vaut ce qu'elle peut valoir
Dis moi si ça peut te convenir

Private Sub CommandButton1_Click()
Dim lot1, lot2, der1, der2, I, K, J As Long

der1 = Cells(Rows.Count, 2).End(xlUp).Row
der2 = Cells(Rows.Count, 6).End(xlUp).Row

    For I = 3 To der2
    lot2 = Cells(I, 6)
        For K = 3 To der1
            lot1 = Cells(K, 2)
                If lot2 = lot1 Then Cells(K, 1) = K
        Next K
    Next I
    For J = 3 To Cells(Rows.Count, 6).End(xlUp).Row
       ' MsgBox J
        If Cells(J, 1) = "" Then Range(Cells(J, 6), Cells(J, 8)).Copy: Cells(J, 6).Select: ActiveSheet.Paste: Range(Cells(J, 6), Cells(J, 8)).Delete: 
    Next J

End Sub
Le 25/01/2025 à 09:44

Bonjour Jacky,

Merci pour ta proposition de macro, je teste et lors de son execution et je comprends que ta macro identifie les numéros de lot situé en colonne F qui sont sans correspondance avec les n° de lot de la colonne B en ajoutant une série de nombre en colonne A.

Cependant il me faudrait un alignement de la colonne F entre les N° de lot de la colonne B et F qui se correspondent et si un numero de lot de la colonne F ne correspond pas, la macro doit déplacer vers le bas de la colonne Fsur la première ligne vide ce nouveau numéro de lot ( Or ta proposition de macro supprime le n° de lot de la colonne F)

Je remets mon fichier avec des explications plus détaillées

12test-mercuriale-copie.xlsx (24.06 Ko)
Le 25/01/2025 à 13:31

Bonjour Diabolo,

Avant de me replonger dans ton projet je vais faire un petit bilan de ce que je t'ai proposé, chose que j'aurais du faire quand j'ai envoyé ma proposition

1) je cherche les correspondances entre les lots 1 (colonne B) et les lots 2 (colonne F) . Je passe en revue, l'un après l'autre, les lots 2 et regarde si un lot 1 lui correspond. Si c'est le cas je le signale en inscrivant dans la colonne A le numéro de la ligne correspondante à ce lot 2. J'aurais pi tout simplement mettre un "x" au lieu du numéro de ligne.

2) je passe en revue le contenu des cellules de la colonne A. Si une cellule est vide c'est qu'il n'y a aucune correspondance entre le lot 1 et le lot 2 donc il faut le "rejeter" en fin de colonnes F, G et H et le supprimer là où il se trouve actuellement. voila pourquoi

Or ta proposition de macro supprime le n° de lot de la colonne F

mais avant d'être supprimé il est bien "rejeté" en fin de la colonne F, G et H

        If Cells(J, 1) = "" Then Range(Cells(J, 6), Cells(J, 8)).Copy: Cells(J, 6).Select: ActiveSheet.Paste: Range(Cells(J, 6), Cells(J, 8)).Delete:

mon erreur est donc située sur cette ligne, je vais voir cela
Toutefois essaie avec

        If Cells(J, 1) = "" Then Range(Cells(J, 6), Cells(J, 8)).Copy: Cells(der2, 6).Select: ActiveSheet.Paste: Range(Cells(J, 6), Cells(J, 8)).Delete: 'rg = rg + 1

A ce soir

Jacky

Le 25/01/2025 à 15:47

Re à tous,

Tu peux le faire via un dictionnaire, restitution sur une autre feuille.

Je n'ai gardé que 6 colonnes de la feuille source (2 blocs de 3 colonnes), ne sachant pas trop quelles colonnes il fallait restituer.

Option Explicit
Sub test1()
    Dim a, i As Long, ii As Long, iii As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Feuil2").Range("a1").CurrentRegion
        a = .Value2
        For ii = 1 To UBound(a, 2) Step 3
            For i = 2 To UBound(a, 1)
                If a(i, ii) <> "" Then
                    If Not dico.exists(a(i, ii)) Then
                        ReDim w(1 To UBound(a, 2))
                    Else
                        w = dico(a(i, ii))
                    End If
                    For iii = 1 To 3
                        w(iii + IIf(ii = 1, 0, 3)) = _
                        a(i, iii + IIf(ii = 1, 0, 3))
                    Next
                    dico(a(i, ii)) = w
                End If
            Next
        Next
    End With
    If Not Evaluate("isref('Alignement'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Alignement"
    With Sheets("Alignement")
        With .Cells(1)
            .CurrentRegion.Clear
            .Resize(, UBound(a, 2)).Value = Application.Index(a, 1, 0)
            .Offset(1).Resize(dico.Count, UBound(a, 2)).Value = Application.Index(dico.items, 0, 0)
            With .CurrentRegion
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .Borders(xlInsideVertical).Weight = xlThin
                .BorderAround Weight:=xlThin
                With .Rows(1)
                    .HorizontalAlignment = xlCenter
                    .Font.Size = 11
                    .BorderAround Weight:=xlThin
                    .Interior.ColorIndex = 43
                End With
                .Columns(3).NumberFormat = Sheets("Feuil2").[C2].NumberFormat
                .Columns(6).NumberFormat = Sheets("Feuil2").[C2].NumberFormat
                .Columns.AutoFit
            End With
        End With
    End With
    Set dico = Nothing
End Sub
14test-mercuriale-copie.xlsm (34.67 Ko)
.Columns(3).NumberFormat = "_(* #,##0.00 €_);_(* (#,##0.00 €);_(* ""-""??€_);_(@_)"

klin89

Le 26/01/2025 à 08:38

Bonjour Klin89, Jacky,

Merci pour votre aide et bravo pour votre travail formidable.

Klin89, le résultat de la macro semble parfait… je la testerai mieux aujourd'hui et je te tiens informer

Jacky, merci beaucoup pour ton investissement et le résultat arrivait aussi très proche de ce que je souhaitais

Le 26/01/2025 à 10:12

Bonjour Klin89,

Je souhaiterais développer l'utilisation du fichier car les prix évoluent tous les trimestres...

Si je crée un 3eme "N°de lot, produit, prix" en GHI, est ce possible de générer un alignement en prenant en compte cette fois ci les colonnes DI (Feuil2)?

et dans la feuil ("Alignement"), de décaler vers la droite et cela à l'infini en laissant une colonne vide (lol)

Je remets le fichier pour plus de détails

7test-mercuriale-copie-1.xlsm (47.86 Ko)
Le 26/01/2025 à 18:46

Re diabolo162,

vois ceci :

Option Explicit
Sub test2()
    Dim a, w, i As Long, ii As Long, iii As Byte, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Feuil2").Range("a1").CurrentRegion
        a = .Value2
        For ii = 1 To UBound(a, 2) Step 3
            For i = 3 To UBound(a, 1)
                If a(i, ii) <> "" Then
                    If Not dico.exists(a(i, ii)) Then
                        ReDim w(1 To UBound(a, 2) + 3)
                    Else
                        w = dico(a(i, ii))
                    End If
                    For iii = 1 To 3
                        Select Case ii
                        Case 1
                            w(iii) = a(i, iii)
                        Case 4
                            w(iii + 4) = a(i, iii + 3)
                        Case 7
                            w(iii + 8) = a(i, iii + 6)
                        End Select
                    Next
                    dico(a(i, ii)) = w
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = False
    If Not Evaluate("isref('Alignement1'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Alignement1"
    With Sheets("Alignement1")
        .UsedRange.Clear
        With .Cells(1)
            .Resize(, UBound(a, 2) + 3).Value = [{"","2024","","","","2025","","","","2026","",""}]
            .Offset(1).Resize(, UBound(a, 2) + 3).Value = _
            [{"N° de lot","Produits","Prix","","N° de lot","Produits","Prix","","N° de lot","Produits","Prix",""}]
            .Offset(2).Resize(dico.Count, UBound(a, 2) + 3).Value = Application.Index(dico.items, 0, 0)
            With .Resize(dico.Count + 2, UBound(a, 2) + 3)
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .Borders(xlInsideVertical).Weight = xlThin
                .BorderAround Weight:=xlThin
                With .Rows("1:2")
                    .HorizontalAlignment = xlCenter
                    .Font.Size = 11
                    .BorderAround Weight:=xlThin
                    .Interior.ColorIndex = 45
                End With
                .Columns(3).NumberFormat = "_(* #,##0.00 €_);_(* (#,##0.00 €);_(* ""-""??€_);_(@_)"
                .Columns(7).NumberFormat = "_(* #,##0.00 €_);_(* (#,##0.00 €);_(* ""-""??€_);_(@_)"
                .Columns(11).NumberFormat = "_(* #,##0.00 €_);_(* (#,##0.00 €);_(* ""-""??€_);_(@_)"
                .Columns.AutoFit
            End With
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Le 26/01/2025 à 20:58

Merci Klin89

Je te remercie!!! C'est parfait

Rechercher des sujets similaires à "macro repositionner valeurs bonne ligne"