Macro suppression de données sous condition + réorganisation donnée par li

Bonjour

dans mon fichier j'ai actuellement une mise en forme conditionnel qui m'indique que si la valeur concernée est trouvée dans la colonne d'un autre onglet, elle doit apparaitre en orange => cela me donne l'info que je peux supprimer manuellement cette donnée.

Je souhaiterai mettre en place une macro permettant de faire cette manip : regarder si les valeurs de la zone se trouve se trouvent dans la colonne si oui dans ce cas là enlever la valeur de la zone et si possible réorganiser les infos de la ligne en ne laissant pas de case vide.

L'onglet concerné est : affectation lot-chariot il faut comparer les données de la zone en bleu avec la colonne A de l'onglet lot finis

5macrosup.zip (339.34 Ko)

merci

Bonjour,

Un essai ...

Placer ce code dans un module > disons au bas du Module1 ...

Private Sub Nettoyage()
Dim MaPlage As Range
Dim MaPlageR As Range
Dim Cl As Range
Dim Clr As Range
Dim X As Integer

    Set MaPlage = Worksheets("affectation lot-chariot").Range("B2:H" & Worksheets("affectation lot-chariot").UsedRange.Rows.Count)
    Set MaPlageR = Worksheets("lot finis").Range("A2:A" & Worksheets("lot finis").UsedRange.Rows.Count)

    For Each Cl In MaPlage
        Set Clr = MaPlageR.Find(What:=Cl, LookAt:=xlWhole)
        If Not Clr Is Nothing Then Cl.ClearContents
    Next Cl

    For X = Worksheets("affectation lot-chariot").UsedRange.Rows.Count To 2 Step -1
        If Application.WorksheetFunction.CountA(Range(Cells(X, "B"), Cells(X, "H"))) = 0 Then
            Range(Cells(X, "B"), Cells(X, "H")).Delete Shift:=xlUp
        End If
    Next X
End Sub

ric

Bonjour Ric

cela supprime bien les lots qui sont passés en finis.

Par contre au niveau remise en forme des données restantes cela supprime des lignes et décales les données vers le haut.

Bonjour,

J'ai donc mal interprété ton propos ...

Donc ... je laisse les lignes vides ...

Et pour chaque ligne ... l'on déplace vers à gauche les adonnées afin qu'il n'y ait plus de cellules vides entre les données ...

Est-ce bien cela ?

ric

Oui c'est bien cela la structure du tableau ne doit pas changer.

Il faut juste déplacer les valeurs à gauche pour chaque ligne afin de ne pas avoir de zone vide.

si on a un tableau comme cela :

lotlotlotlot
1av
2bc
3de

on cherche à avoir les parties rouges ne "bouge pas"' et les données sont "rassemblées" par ligne en partant de la gauche.

lotlotlotlot
1av
2bc
3de

Bonjour,

Excuse-moi, je comprends vite ... mais, il faut m'expliquer longtemps avant ...

Private Sub Nettoyage()
Dim MaPlage As Range
Dim MaPlageR As Range
Dim Cl As Range
Dim Clr As Range
Dim X As Integer, Z As Byte
Dim Ws As Worksheet

    Application.ScreenUpdating = False

    Set Ws = Worksheets("affectation lot-chariot")
    Set MaPlage = Ws.Range("B2:H" & Ws.UsedRange.Rows.Count)
    Set MaPlageR = Worksheets("lot finis").Range("A2:A" & Worksheets("lot finis").UsedRange.Rows.Count)

    For Each Cl In MaPlage
        Set Clr = MaPlageR.Find(What:=Cl, LookAt:=xlWhole)
        If Not Clr Is Nothing Then Cl.ClearContents
    Next Cl

    For X = Ws.UsedRange.Rows.Count To 2 Step -1
        For Z = 2 To 7
            Do While Ws.Cells(X, Z) = "" And Application.WorksheetFunction.CountA(Range(Cells(X, Z + 1), Cells(X, 8))) > 0
                Range(Cells(X, Z + 1), Cells(X, 8)).Copy Ws.Cells(X, Z)
            Loop
        Next Z
    Next X
End Sub

ric

Bonjour Ric

Je viens de tester cela ne fonctionne pas à chaque fois.

La macro est longue a s’exécuter environ 30-40 secondes.

Des fois elle recopie le numéro du lot sur toute la ligne.

Et j'ai même eu un plantage d'excel.

J'ai agrandi un peu mon tableau jusque L, j'ai ajouté cette modif dans ta macro. je ne pense pas mettre trompé.

3macrosup.zip (341.11 Ko)

Ta macro est affectée au bouton vert nettoyage scan.

Bonjour,

Si cela était si long ... soit la machine est de faible capacité ou il y a trop de processus qui tournent en arrière plan ...

Il est bien entendu qu'en passant pas une variable tableau ... le processus gagnerait en rapidité ... mais, c'est moi qui ne réussit pas à bien concevoir ces fameuses variables tableau.

Quoi qu'il en soit ... cette version devrait être quand même plus rapide > j'ai ajouté une condition pour terminer les boucles plus rapidement ...

Sub Nettoyage_onglet_scan()
Dim MaPlage As Range
Dim MaPlageR As Range
Dim Cl As Range
Dim Clr As Range
Dim X As Integer, Z As Byte
Dim Ws As Worksheet

    Worksheets("affectation lot-chariot").Activate
    Application.ScreenUpdating = False

    Set Ws = Worksheets("affectation lot-chariot")

    Set MaPlage = Ws.Range("B2:L" & Ws.UsedRange.Rows.Count)
    Set MaPlageR = Worksheets("lot finis").Range("A2:A" & Worksheets("lot finis").UsedRange.Rows.Count)

    For Each Cl In MaPlage
        Set Clr = MaPlageR.Find(What:=Cl, LookAt:=xlWhole)
        If Not Clr Is Nothing Then Cl.ClearContents
    Next Cl

    For X = Ws.UsedRange.Rows.Count To 2 Step -1
        For Z = 2 To 11      ' << modif pour l'ajout des colonnes
            If Application.WorksheetFunction.CountA(Range(Cells(X, Z + 1), Cells(X, 12))) = 0 Then Exit For    ' <<< ajout de la condition
            Do While Ws.Cells(X, Z) = "" And Application.WorksheetFunction.CountA(Range(Cells(X, Z + 1), Cells(X, 12))) > 0
                Range(Cells(X, Z + 1), Cells(X, 12)).Copy Ws.Cells(X, Z)
            Loop
        Next Z
    Next X
End Sub

ric

ça tourne déjà plus vite, merci pour les modifs.

Par contre j'ai toujours le problème de copie de la valeur sur l'ensemble de la ligne.

Cela se produit quand la valeur a déplacé est dans la dernière colonne du tableau.

image

Bonjour,

C'est sûrement autre chose qui interfère ... car ici, je n'ai pas ce souci ... je vais regarder ton dernier fichier de prêt ...

ric

Bonjour,

Ce sont les mises en forme conditionnelle qui posent problème ... malgré que je n'ai pas ce souci sur ma machine ...

Essai en désactivant temporairement les événements > regarde les deux lignes > ' <<< ajout

Sub Nettoyage_onglet_scan()
Dim MaPlage As Range
Dim MaPlageR As Range
Dim Cl As Range
Dim Clr As Range
Dim X As Integer, Z As Byte
Dim Ws As Worksheet

    Worksheets("affectation lot-chariot").Activate
    Application.ScreenUpdating = False
    Application.EnableEvents = False     ' <<< ajout

    Set Ws = Worksheets("affectation lot-chariot")

    Set MaPlage = Ws.Range("B2:L" & Ws.UsedRange.Rows.Count)
    Set MaPlageR = Worksheets("lot finis").Range("A2:A" & Worksheets("lot finis").UsedRange.Rows.Count)

    For Each Cl In MaPlage
        Set Clr = MaPlageR.Find(What:=Cl, LookAt:=xlWhole)
        If Not Clr Is Nothing Then Cl.ClearContents
    Next Cl

    For X = Ws.UsedRange.Rows.Count To 2 Step -1
        For Z = 2 To 11
            If Application.WorksheetFunction.CountA(Range(Cells(X, Z + 1), Cells(X, 12))) = 0 Then Exit For
            Do While Ws.Cells(X, Z) = "" And Application.WorksheetFunction.CountA(Range(Cells(X, Z + 1), Cells(X, 12))) > 0
                Range(Cells(X, Z + 1), Cells(X, 12)).Copy Ws.Cells(X, Z)
            Loop
        Next Z
    Next X
    Application.EnableEvents = True     ' <<< ajout
End Sub

ric

J'ai essayé le problème persiste.

Du coup j'ai supprimé les mises en forme conditionnelle mais j'ai toujours le problème...

Et si on étend la zone de la macro jusque la colonne M sachant qu'elle sera toujours vide ça peut être une solution?

J'utilise excel 2016 le problème vient peut etre de là.

Bonjour,

N'aurais-tu pas des macros complémentaires ou un pack de macro ?

Est-ce que ta version d'Excel est une version 32 bits ou 64 bits ??

ric

Bonjour

non pour moi je n'ai pas de pack de macro.

Les seuls macros que j'ai sont celles créés dans mon fichier.

J'ai une version 64 bits.

Bonjour,

J'ai pris le temps d'installer une version 64 bits de Microsoft 365 FR sur une de mes machines ...

Le fichier fonctionne bien sans souci ...

Je ne sais pas trop quoi en penser ...

N'as tu pas un autre ordinateur sur lequel tu pourrais tester le fichier ?

ric

Bonjour

j'ai testé sur mon autre Pc même problème.

Mais c'est pas grave je peux me débrouiller.

merci beaucoup pour ton aide.

Rechercher des sujets similaires à "macro suppression donnees condition reorganisation donnee"