suppression de données

Y compris Power BI, Power Query et toute autre question en lien avec Excel
c
choufi_51
Jeune membre
Jeune membre
Messages : 18
Inscrit le : 18 mai 2017
Version d'Excel : 2013

Message par choufi_51 » 18 mai 2017, 14:20

alors pour te répondre :
- en fait, par rapport à ce que j'ai besoin de faire, ce qui m'importe, c'est surtout la colonne mail. L'idéal, concernant la couleur, serait que, dans chacune des 2 macros, les mails de la liste ET les mails de la base de données, soient colorés.
- en ce qui concerne l'ajout, oui en effet on peut ajouter l'ensemble de la ligne (toujours en colorant les cellules de la base et de la liste).

ce qui donne :

- une macro pour mettre en évidence, dans la base de données, les mails qui sont contenu dans la liste (cellule de couleur dans la base et dans la liste)
- une macro pour repérer les mails qui sont dans la liste, mais qui ne sont pas dans la base. Puis ajouter à la base, ces mails + autres infos contenues dans la ligne, de la liste. (cellule de couleur dans la base et dans la liste)

C'est plus clair pour toi ?
Avatar du membre
ThauThème
Passionné d'Excel
Passionné d'Excel
Messages : 4'047
Appréciations reçues : 212
Inscrit le : 19 octobre 2014
Version d'Excel : 2010 FR

Message par ThauThème » 18 mai 2017, 16:28

Re,

J'ai oublié de te redemander s'il y avait des doublons de mail dans la base. Ça permettrait d'accélérer l'exécution des macros !...


Re,

Avec la même procédure que je t'ai donnée ce matin, supprime le premier code, puis copie/colle les nouveaux codes ci-dessous. Les procédures se nomment désormais Supprimer, Identifier et Ajouter...

Sub Supprimer()
Dim L As Worksheet 'déclare la variable L (onglet Liste)
Dim B As Worksheet 'déclare la variable B (onglet Base)
Dim TVL As Variant 'déclare la variable TVL (Tableau des Valeurs de la Liste)
Dim TVB As Variant 'déclare la variable TVB (Tableau des Valeurs de la Base)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set L = Worksheets("mail à enlever de la base") 'définit l'onglet L
Set B = Worksheets("base de données") 'définit l'onglet B
TVL = L.Range("A1").CurrentRegion 'définit le tableau des valeurs de la liste TVL
TVB = B.Range("A1").CurrentRegion 'définit le tableau des valeurs de la base TVB
For I = 1 To UBound(TVL, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs de la liste TVL
    For J = 1 To UBound(TVB, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs de la base TVB
        'si les deux valeurs sont identiques, efface la cellule ligne J colonne 1 de l'onget B
        If TVL(I, 1) = TVB(J, 1) Then B.Cells(J, 1).Value = ""
     Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "les données ont été effacées !" 'message
End Sub

Sub Identifier()
Dim L As Worksheet 'déclare la variable L (onglet Liste)
Dim B As Worksheet 'déclare la variable B (onglet Base)
Dim TVL As Variant 'déclare la variable TVL (Tableau des Valeurs de la Liste)
Dim TVB As Variant 'déclare la variable TVB (Tableau des Valeurs de la Base)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set L = Worksheets("mail à identifier dans la base") 'définit l'onglet L
Set B = Worksheets("base de données") 'définit l'onglet B
TVL = L.Range("A1").CurrentRegion 'définit le tableau des valeurs de la liste TVL
TVB = B.Range("A1").CurrentRegion 'définit le tableau des valeurs de la base TVB
For I = 1 To UBound(TVL, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs de la liste TVL
    For J = 1 To UBound(TVB, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs de la base TVB
        'si les deux valeurs sont identiques
        If TVL(I, 1) = TVB(J, 1) Then
            L.Cells(I, 1).Interior.ColorIndex = 4 'colore la cellule de la liste en vert
            B.Cells(J, 1).Interior.ColorIndex = 4 'colore la cellule de la base en vert
        End If
     Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "les données ont été identifiées !" 'message
End Sub

Sub Ajouter()
Dim L As Worksheet 'déclare la variable L (onglet Liste)
Dim B As Worksheet 'déclare la variable B (onglet Base)
Dim TVL As Variant 'déclare la variable TVL (Tableau des Valeurs de la Liste)
Dim TVB As Variant 'déclare la variable TVB (Tableau des Valeurs de la Base)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément
Dim TEST As Boolean 'déclare la variable TEST
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set L = Worksheets("mail à ajouter dans la base") 'définit l'onglet L
Set B = Worksheets("base de données") 'définit l'onglet B
TVL = L.Range("A1").CurrentRegion 'définit le tableau des valeurs de la liste TVL
TVB = B.Range("A1").CurrentRegion 'définit le tableau des valeurs de la base TVB
For I = 1 To UBound(TVL, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs de la liste TVL
    TEST = False 'initialise la variable TEST
    For J = 1 To UBound(TVB, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs de la base TVB
        'condition : si les deux valeurs sont identiques
        If TVL(I, 1) = TVB(J, 1) Then
            TEST = True 'redéfinit la variable TEST
            Exit For 'sort de la boucle 1
        End If 'fin de la condition
     Next J 'prochaine ligne de la boucle 2
     If TEST = False Then 'condition : si la variable TEST est fausse (donc si on n'a pas trouvé l'email)
        Set DEST = B.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
        L.Cells(L, 1).Resize(1, UBound(TVL, 2)).Copy DEST 'copie les données de la ligne et les colle dans DEST
        L.Cells(I, 1).Interior.ColorIndex = 3 'colore la cellule de la liste en rouge
        DEST.Interior.ColorIndex = 3 'colore DEST en rouge
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "les données ont été ajoutées !" 'message
End Sub
À plus,

ThauTheme


Je suis Charlie
VBA m'éclate, les formules m'ennuient ! Je n'y peux rien c'est comme ça...
c
choufi_51
Jeune membre
Jeune membre
Messages : 18
Inscrit le : 18 mai 2017
Version d'Excel : 2013

Message par choufi_51 » 18 mai 2017, 17:38

merci !!!
j'essaie ça en rentrant chez moi.
pour les doublons, oui c'est fortement possible qu'il y en ait dans la base et dans la liste.
c
choufi_51
Jeune membre
Jeune membre
Messages : 18
Inscrit le : 18 mai 2017
Version d'Excel : 2013

Message par choufi_51 » 18 mai 2017, 22:08

bonsoir ThauThème,

je viens de tester tes macros !
Alors :
- pour "supprimer" et "identifier", ça fonctionne bien, sauf quand il y a une cellule "mail" vide. par exemple, de A1 à A20 on a des mails, cellule vide en A21, A22 et A23, puis à nouveau des mails dans les cellules suivantes : la macro supprime ou identifie les mails jusque A20, mais ne traite plus la suite de la liste.
- pour "supprimer", est-ce que tu peux faire en sorte que les adresses de la liste qui sont effectivement supprimées de la base, soient colorées en rose par exemple (dans la liste) ?
- pour "ajouter", ça ne semble pas fonctionner, il y a un bug "erreur d'exécution 13", et quand je fais débogage, c'est cette ligne qui est surlignée : L.Cells(L, 1).Resize(1, UBound(TVL, 2)).Copy DEST 'copie les données de la ligne et les colle dans DEST

Et apparemment pour les doublons c'est ok, ils sont pris en compte ^^

j'espère ne pas trop t'embêter...

Bonne soirée et merci encore pour ton aide

C.
Avatar du membre
ThauThème
Passionné d'Excel
Passionné d'Excel
Messages : 4'047
Appréciations reçues : 212
Inscrit le : 19 octobre 2014
Version d'Excel : 2010 FR

Message par ThauThème » 19 mai 2017, 11:35

Bonjour Choufi, bonjour le forum,

Les nouveaux code à remplacer :
Sub Supprimer()
Dim L As Worksheet 'déclare la variable L (onglet Liste)
Dim B As Worksheet 'déclare la variable B (onglet Base)
Dim DLL As Long 'déclare la variable DLL (Dernière Ligne Liste)
Dim DLB As Long 'déclare la variable DLB (Dernière Ligne Base)
Dim DCL As Byte 'déclare la variable DLL (Dernière Ligne Liste)
Dim DCB As Byte 'déclare la variable DLB (Dernière Ligne Base)
Dim TVL As Variant 'déclare la variable TVL (Tableau des Valeurs de la Liste)
Dim TVB As Variant 'déclare la variable TVB (Tableau des Valeurs de la Base)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set L = Worksheets("mail à enlever de la base") 'définit l'onglet L
Set B = Worksheets("base de données") 'définit l'onglet B
DLL = L.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLL de la colonne A de l'onglet L
DLB = B.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLB de la colonne A de l'onglet B
DCL = L.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCL de la ligne 1 de l'onglet L
DCB = B.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCB de la ligne 1 de l'onglet B
TVL = L.Range(L.Cells(1, 1), L.Cells(DLL, DCL)) 'définit le tableau des valeurs de la liste TVL
TVB = B.Range(B.Cells(1, 1), B.Cells(DLB, DCB)) 'définit le tableau des valeurs de la liste TVL
For I = 1 To UBound(TVL, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs de la liste TVL
    For J = 1 To UBound(TVB, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs de la base TVB
    If TVL(I, 1) = TVB(J, 1) Then 'si les deux valeurs sont identiques
        B.Cells(J, 1).Value = "" 'efface la cellule ligne J colonne 1 de l'onget B
        L.Cells(I, 1).Interior.ColorIndex = 38 'couleur rose dans le cellule de la liste
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "les données ont été effacées !" 'message
End Sub

Sub Identifier()
Dim L As Worksheet 'déclare la variable L (onglet Liste)
Dim B As Worksheet 'déclare la variable B (onglet Base)
Dim DLL As Long 'déclare la variable DLL (Dernière Ligne Liste)
Dim DLB As Long 'déclare la variable DLB (Dernière Ligne Base)
Dim DCL As Byte 'déclare la variable DLL (Dernière Ligne Liste)
Dim DCB As Byte 'déclare la variable DLB (Dernière Ligne Base)
Dim TVL As Variant 'déclare la variable TVL (Tableau des Valeurs de la Liste)
Dim TVB As Variant 'déclare la variable TVB (Tableau des Valeurs de la Base)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set L = Worksheets("mail à identifier dans la base") 'définit l'onglet L
Set B = Worksheets("base de données") 'définit l'onglet B
DLL = L.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLL de la colonne A de l'onglet L
DLB = B.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLB de la colonne A de l'onglet B
DCL = L.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCL de la ligne 1 de l'onglet L
DCB = B.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCB de la ligne 1 de l'onglet B
TVL = L.Range(L.Cells(1, 1), L.Cells(DLL, DCL)) 'définit le tableau des valeurs de la liste TVL
TVB = B.Range(B.Cells(1, 1), B.Cells(DLB, DCB)) 'définit le tableau des valeurs de la liste TVL
For I = 1 To UBound(TVL, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs de la liste TVL
    For J = 1 To UBound(TVB, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs de la base TVB
        'si les deux valeurs sont identiques
        If TVL(I, 1) = TVB(J, 1) Then
            L.Cells(I, 1).Interior.ColorIndex = 4 'colore la cellule de la liste en vert
            B.Cells(J, 1).Interior.ColorIndex = 4 'colore la cellule de la base en vert
        End If
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "les données ont été identifiées !" 'message
End Sub

Sub Ajouter()
Dim L As Worksheet 'déclare la variable L (onglet Liste)
Dim B As Worksheet 'déclare la variable B (onglet Base)
Dim DLL As Long 'déclare la variable DLL (Dernière Ligne Liste)
Dim DLB As Long 'déclare la variable DLB (Dernière Ligne Base)
Dim DCL As Byte 'déclare la variable DLL (Dernière Ligne Liste)
Dim DCB As Byte 'déclare la variable DLB (Dernière Ligne Base)
Dim TVL As Variant 'déclare la variable TVL (Tableau des Valeurs de la Liste)
Dim TVB As Variant 'déclare la variable TVB (Tableau des Valeurs de la Base)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set L = Worksheets("mail à identifier dans la base") 'définit l'onglet L
Set B = Worksheets("base de données") 'définit l'onglet B
DLL = L.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLL de la colonne A de l'onglet L
DLB = B.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLB de la colonne A de l'onglet B
DCL = L.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCL de la ligne 1 de l'onglet L
DCB = B.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCB de la ligne 1 de l'onglet B
TVL = L.Range(L.Cells(1, 1), L.Cells(DLL, DCL)) 'définit le tableau des valeurs de la liste TVL
TVB = B.Range(B.Cells(1, 1), B.Cells(DLB, DCB)) 'définit le tableau des valeurs de la liste TVL
For I = 1 To UBound(TVL, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs de la liste TVL
    TEST = False 'initialise la variable TEST
    For J = 1 To UBound(TVB, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs de la base TVB
        'condition : si les deux valeurs sont identiques
        If TVL(I, 1) = TVB(J, 1) Then
        TEST = True 'redéfinit la variable TEST
        Exit For 'sort de la boucle 1
        End If 'fin de la condition
    Next J 'prochaine ligne de la boucle 2
    If TEST = False Then 'condition : si la variable TEST est fausse (donc si on n'a pas trouvé l'email)
    Set DEST = B.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    L.Range(L.Cells(I, 1), L.Cells(I, DCL)).Copy DEST 'copie les données de la ligne et les colle dans DEST
    L.Cells(I, 1).Interior.ColorIndex = 3 'colore la cellule de la liste en rouge
    DEST.Interior.ColorIndex = 3 'colore DEST en rouge
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "les données ont été ajoutées !" 'message
End Sub
Dis-moi si ça te convient...
À plus,

ThauTheme


Je suis Charlie
VBA m'éclate, les formules m'ennuient ! Je n'y peux rien c'est comme ça...
c
choufi_51
Jeune membre
Jeune membre
Messages : 18
Inscrit le : 18 mai 2017
Version d'Excel : 2013

Message par choufi_51 » 19 mai 2017, 12:48

Bonjour ThauThème, Bonjour tout le monde,

merci pour ton travail.

je viens de tester, ca marche bien pour pour "identifier". Merci !

par contre :

- dans "supprimer" il dit qu'il y a un next sans for et surligne ce next : Next J 'prochaine ligne de la boucle 2

- dans ajouter :
-il dit que les contacts sont bien ajoutés, mais en fait il n'y sont pas.
-ne colore pas les cases
Avatar du membre
ThauThème
Passionné d'Excel
Passionné d'Excel
Messages : 4'047
Appréciations reçues : 212
Inscrit le : 19 octobre 2014
Version d'Excel : 2010 FR

Message par ThauThème » 19 mai 2017, 16:39

Re,

Je suis désolé mais il me faut un fichier pour que je puisse tester avant de t'envoyer sinon on va y passer des lustres...
À plus,

ThauTheme


Je suis Charlie
VBA m'éclate, les formules m'ennuient ! Je n'y peux rien c'est comme ça...
c
choufi_51
Jeune membre
Jeune membre
Messages : 18
Inscrit le : 18 mai 2017
Version d'Excel : 2013

Message par choufi_51 » 20 mai 2017, 10:52

Bonjour ThauThème, bonjour à tous,

ok pas de soucis, je t'envoie le fichier !
contact-fichier de travail.xlsx
(121.36 Kio) Téléchargé 4 fois
Avatar du membre
ThauThème
Passionné d'Excel
Passionné d'Excel
Messages : 4'047
Appréciations reçues : 212
Inscrit le : 19 octobre 2014
Version d'Excel : 2010 FR

Message par ThauThème » 21 mai 2017, 12:53

Bonjour Choufi, bonjour le forum,

Avec le fichier ça m'a permis de tester et de corriger les erreurs... Attention ! Dans le fichier fournis la base se nomme base de donnée sans le s j'ai donc adapté le code. Soit tu modifies le nom de l'onglet, soit tu adaptes le code mais il faut que les deux noms soient identiques... Comme la plupart des variables sont communes aux trois macros, je les ai déclarées en tête de module comme Private au lieu de Dim. Remplace l'ancien code par celui-ci dans sa totalité.

Le code testé :
Private L As Worksheet 'déclare la variable L (onglet Liste)
Private B As Worksheet 'déclare la variable B (onglet Base)
Private DLL As Long 'déclare la variable DLL (Dernière Ligne Liste)
Private DLB As Long 'déclare la variable DLB (Dernière Ligne Base)
Private DCL As Byte 'déclare la variable DLL (Dernière Ligne Liste)
Private DCB As Byte 'déclare la variable DLB (Dernière Ligne Base)
Private TVL As Variant 'déclare la variable TVL (Tableau des Valeurs de la Liste)
Private TVB As Variant 'déclare la variable TVB (Tableau des Valeurs de la Base)
Private I As Long 'déclare la variable I (Incrément)
Private J As Long 'déclare la variable J (incrément

Sub Supprimer()
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set L = Worksheets("mail à enlever de la base") 'définit l'onglet L
Set B = Worksheets("base de donnée") 'définit l'onglet B
DLL = L.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLL de la colonne A de l'onglet L
DLB = B.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLB de la colonne A de l'onglet B
DCL = L.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCL de la ligne 1 de l'onglet L
DCB = B.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCB de la ligne 1 de l'onglet B
TVL = L.Range(L.Cells(1, 1), L.Cells(DLL, DCL)) 'définit le tableau des valeurs TVL de la liste
TVB = B.Range(B.Cells(1, 1), B.Cells(DLB, DCB)) 'définit le tableau des valeurs TVB de la base
For I = 1 To UBound(TVL, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs de la liste TVL
    If TVL(I, 1) <> "" Then 'condition 1 : si la donnée ligne I colonne 1 de TVL n'est pas vide
        For J = 1 To UBound(TVB, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs de la base TVB
        If TVL(I, 1) = TVB(J, 1) Then 'condition 2 : si les deux valeurs sont identiques
            B.Cells(J, 1).Value = "" 'efface la cellule ligne J colonne 1 de l'onget B
            L.Cells(I, 1).Interior.ColorIndex = 38 'couleur rose dans la cellule de la liste
        End If 'fin de la condition 2
        Next J 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "les données ont été effacées !" 'message
End Sub

Sub Identifier()

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set L = Worksheets("mail à identifier dans la base") 'définit l'onglet L
Set B = Worksheets("base de donnée") 'définit l'onglet B
DLL = L.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLL de la colonne A de l'onglet L
DLB = B.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLB de la colonne A de l'onglet B
DCL = L.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCL de la ligne 1 de l'onglet L
DCB = B.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCB de la ligne 1 de l'onglet B
TVL = L.Range(L.Cells(1, 1), L.Cells(DLL, DCL)) 'définit le tableau des valeurs TVL de la liste
TVB = B.Range(B.Cells(1, 1), B.Cells(DLB, DCB)) 'définit le tableau des valeurs TVB de la liste base
For I = 1 To UBound(TVL, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs de la liste TVL
    If TVL(I, 1) <> "" Then 'condition 1 : si la donnée ligne I colonne 1 de TVL n'est pas vide
        For J = 1 To UBound(TVB, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs de la base TVB
        If TVL(I, 1) = TVB(J, 1) Then 'condition 2 : si les deux valeurs sont identiques
            L.Cells(I, 1).Interior.ColorIndex = 4 'colore la cellule de la liste en vert
            B.Cells(J, 1).Interior.ColorIndex = 4 'colore la cellule de la base en vert
        End If 'fin de la condition 2
        Next J 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "les données ont été identifiées !" 'message
End Sub

Sub Ajouter()
Dim TEST As Boolean 'déclare la variable TEST

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set L = Worksheets("mail à ajouter dans la base") 'définit l'onglet L
Set B = Worksheets("base de donnée") 'définit l'onglet B
DLL = L.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLL de la colonne A de l'onglet L
DLB = B.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DLB de la colonne A de l'onglet B
DCL = L.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCL de la ligne 1 de l'onglet L
DCB = B.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DCB de la ligne 1 de l'onglet B
TVL = L.Range(L.Cells(1, 1), L.Cells(DLL, DCL)) 'définit le tableau des valeurs TVL de la liste
TVB = B.Range(B.Cells(1, 1), B.Cells(DLB, DCB)) 'définit le tableau des valeurs TVB de la base
For I = 1 To UBound(TVL, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs de la liste TVL
    TEST = False 'initialise la variable TEST
    If TVL(I, 1) <> "" Then 'condition 1 : si la donnée ligne I colonne 1 de TVL n'est pas vide
        For J = 1 To UBound(TVB, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs de la base TVB
            'condition : si les deux valeurs sont identiques
            If TVL(I, 1) = TVB(J, 1) Then
                TEST = True 'redéfinit la variable TEST
                Exit For 'sort de la boucle 2
            End If 'fin de la condition
        Next J 'prochaine ligne de la boucle 2
        If TEST = False Then 'condition : si la variable TEST est fausse (donc si on n'a pas trouvé l'email)
            Set DEST = B.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
            L.Range(L.Cells(I, 1), L.Cells(I, DCL)).Copy DEST 'copie les données de la ligne et les colle dans DEST
            L.Cells(I, 1).Interior.ColorIndex = 3 'colore la cellule de la liste en rouge
            DEST.Interior.ColorIndex = 3 'colore DEST en rouge
        End If 'fin de la condition
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "les données ont été ajoutées !" 'message
End Sub
À plus,

ThauTheme


Je suis Charlie
VBA m'éclate, les formules m'ennuient ! Je n'y peux rien c'est comme ça...
c
choufi_51
Jeune membre
Jeune membre
Messages : 18
Inscrit le : 18 mai 2017
Version d'Excel : 2013

Message par choufi_51 » 22 mai 2017, 14:33

Wouah Wouah Wouah ! Ca marche nickel !! Un grand merci à toi Thauthème ^^. ça va vraiment bcp m'aider !

Ce week-end j'ai pensé 2 toutes petites dernières macro qui pourraient bien m'aider à faire du tri dans ma base, pour que je puisse regrouper les infos de doublons.

Il faudrait que la nouvelle macro n°4 permette :
- de copier dans un nouvel onglet (qui s'appellerait par exemple "doublon structure") les lignes entières de la base de donnée qui contiennent le même nom de ville + le même nom de structure
exemple :
- ligne 2 : ville = Paris et nom structure = l'apostrophe
- ligne 125 : ville = Paris et nom structure = l'apostrophe
dans le nouvel onglet, j'aurais ces 2 ligne qui apparaitraient, et si possible avec le numéro de la ligne où elles se trouvent dans la base

Et que la nouvelle macro n°5 permette :
- de copier dans un nouvel onglet (qui s'appellerait par exemple "doublon mail"), les lignes entière de la base qui ont la même adresse mail. parce que parfois, une même personne travaille sur plusieurs lieu avec la même adresse mail, donc il ne faut pas que je supprime son mail même s'il est en doublon dans la colonne ^^

Tu crois que tu pourrais me faire ça ? j'en profite le temps que j'ai quelqu'un de compétant sous la main ! y a tellement longtps que je galère ^^

Après normalement ça devrait être bon ;-)
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message