Gestion des doublons VBA

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonsoir,

J'ai pu obtenir ce code dans ce forum que j'ai un peu adapté et qui m'a bien aidé. J'aimerais cependant encore mieux l'adapter mais je n'y arrive pas. Ce script permet le transfert de certaines données d'une feuille vers une autre mais j'aimerais y intégré un message d'erreur s'il y a doublon (colonne A)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, derLig As Integer, lignVide As Integer
If Target.Column <> 12 Then Exit Sub
derLig = Range("A" & Rows.Count).End(xlUp).Row
 
If Target.Row <> derLig Then Exit Sub
If ActiveCell = "RP" Then
'il y a 7 valeurs à transférer
v1 = Cells(derLig, 1): v2 = Cells(derLig, 2): v3 = Cells(derLig, 4)
v4 = Cells(derLig, 8): v5 = Cells(derLig, 9): v6 = Cells(derLig, 11)
'Ouvrir la feuill GM
Sheets("GM").Activate
Worksheets("GM").Unprotect Password:="XENNA"
 
'Recherche de la première ligne vide
lignVide = Sheets("GM").Range("A" & Rows.Count).End(xlUp).Row + 1
'Copie des valeurs dans la feuille active
With ActiveSheet
    .Cells(lignVide, 1) = v1 
    .Cells(lignVide, 2) = v3
    .Cells(lignVide, 4) = v6
    .Cells(lignVide, 5) = v2
    .Cells(lignVide, 8) = v4
    .Cells(lignVide, 9) = v5
End With
 
 
Worksheets("GM").Protect Password:="XENNA"
End If
 
 
End Sub

Merci !

Bonsoir,

Un exemple à incorporer dans ton code.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim derLig As Integer, adresse As String
 If Target.Column <> 2 Then Exit Sub 'exemple avec saisies en A et B
 derLig = Range("A" & Rows.Count).End(xlUp).Row
 If Target.Row <> derLig Then Exit Sub
     v1 = Cells(derLig, 1)
        'Recherche si la nouvelle donnée existe déjà dans la colonne A.
        adresse = Columns(1).Find(What:=v1, After:=Range("A" & derLig).Offset(1, 0), _
        LookAt:=xlWhole, SearchDirection:=xlNext).Address
 
        'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
        'signifie qu'il y a un doublon dans la colonne.
        If adresse <> Range("A" & derLig).Address Then _
            MsgBox "La donnée '" & v1 & _
            "' existe déjà dans la cellule " & adresse
End Sub

13/11/2014, 23h29
Xenna77

Bonsoir,

Merci bcp pour votre proposition mais je n'arrive pas à l'intégrer dans mon code :(, pourriez-vous m'aider davantage ?

Merci :D
14/11/2014, 10h12
polysandre

Bonjour,

Je me permets de te répondre.

Ce code est à intégrer dans le code de la feuille de ton classeur sur laquelle tu veux interdire les doublons ^^.

Quand tu as ta liste d'objets VBA en faisant Alt+F11, tu as une sous liste Microsof Excel Objects et là tu as tes noms de feuilles, tu cliques sur ta feuille concernée et tu colles ce code.

Polyasandre.
14/11/2014, 10h26
vinc_bilb

Bonjour,

Sauf incompréhension de ma part par manque de café chronique, vous pouvez supprimer directement les doublons par la fonction RemoveDuplicates (existe aussi en Excel classique).
Si ça peut aider

Code:

InpRng.RemoveDuplicates Columns:=(RngColAR), Header:=RngAsHeader
14/11/2014, 11h06
Thautheme

Bonjour le fil, bonjour le forum,

Citation:

Envoyé par vinc_bilb

Bonjour,

Sauf incompréhension de ma part par manque de café chronique, vous pouvez supprimer directement les doublons par la fonction RemoveDuplicates (existe aussi en Excel classique).
Si ça peut aider

Code:

InpRng.RemoveDuplicates Columns:=(RngColAR), Header:=RngAsHeader

Belle découverte pour moi ! Je t'offre un café (virtuel) Vincent...
14/11/2014, 11h38
vinc_bilb

Haaa, un café virtuel est un objet non déclaré, donc méfiance! Merci .... :D

Bonsoir à tous,

Je vous remercie pour vos réponses, mais le code de Jean-Claude me convient mieux si ce n'est que j'aimerais compléter ce code en interdisant la copie des données. Dans celui-ci, il m'avertit juste qu'il y a un doublon mais il copie quand même les données. Quelqu'un pourrait m'aider à le compléter en laissant le MsgBox?

Merci pour l'intérêt que vous portez à ma demande.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Private Sub Worksheet_Change(ByVal Target As Range) Dim derLig As Integer, adresse As String If Target.Column <> 2 Then Exit Sub 'exemple avec saisies en A et B derLig = Range("A" & Rows.Count).End(xlUp).Row If Target.Row <> derLig Then Exit Sub v1 = Cells(derLig, 1) 'Recherche si la nouvelle donnée existe déjà dans la colonne A. adresse = Columns(1).Find(What:=v1, After:=Range("A" & derLig).Offset(1, 0), _ LookAt:=xlWhole, SearchDirection:=xlNext).Address 'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela 'signifie qu'il y a un doublon dans la colonne. If adresse <> Range("A" & derLig).Address Then _ MsgBox "La donnée '" & v1 & _ "' existe déjà dans la cellule " & adresse End Sub
NB: le café virtuel est en effet pas déclaré mais je peux t'assurer qu'il est meilleur pour la santé ;)

heu

bonjour

personellement les activâtes et elect a tout va me font dresser les poils à moi
une suggestion

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim derLig As Long, lignVide As Long, tablo(1, 9) As Variant, doublon As Variant
    ici j 'ai reuni les 2 conditions de sortie de sub
    If Target.Column <> 12 Or Target.Row <> Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
 
    derLig = ActiveCell.Row ' ici si on est pas sorti alors on est forcement sur la derniere ligne
 
   If ActiveCell = "RP" Then
        'doublon va devenir la celle qui contient le doublon
        Set doublon = Range("A1:A" & derLig - 1).Find(Cells(derLig, 1), LookIn:=xlValues)
        If Not doublon Is Nothing Then ' si le doublon n'est pas rien alors message
        MsgBox "il y deja cette valeur en ligne :" & doublon.Row
        Else
        ' sinon on fait le boulot et sans tout ces activate qui paralisent le system
        'il y a 7 valeurs que l'on met dans la variables tablo dans les meme colonne que les colonne du  (sheets"GM")qui est la destination
        tablo(1, 1) = Cells(derLig, 1): tablo(1, 2) = Cells(derLig, 4): tablo(1, 4) = Cells(derLig, 11)
        tablo(1, 5) = Cells(derLig, 2): tablo(1, 8) = Cells(derLig, 9): tablo(1, 9) = Cells(derLig, 9)
        With Worksheets("GM")
            .Unprotect Password:="XENNA" ' on deprotege le sheets
            lignVide = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' on cherche la premiere ligne vide en partant d'en bas
           . Cells(lignevide, 1).Resize(1, 9) = tablo ' et enfin on repose le tablo (plus comunement appelé "TRANSPOSE")
            .Protect Password:="XENNA"
        End With
    End If
    End If
End Sub
j'ai pas tester mais ca devrait fonctionner

EDIT/
j'avais oublié le "." devant cells dans la boucle with du sheets("GM")

14/11/2014, 22h17
Xenna77

Bonsoir,

le script bloque à ce niveau :

Code:

.Cells(lignevide, 1).Resize(1, 9) = tablo

Merci pour le suivi ;)
14/11/2014, 22h23
patricktoulon

re

juste avant cette ligne met

Code:

msgbox "ligne vide =" & lignevide & vbcrlf & ubound(tablo) & vbcrlf & tablo(1,1) & ": " & tablo(1,9)

et dis moi ce que te dis le message ?
14/11/2014, 22h27
Xenna77

Erreur d'exécution 1004

Erreur définie par l'application ou l'objet

Débogage
14/11/2014, 22h40
patricktoulon

re

oula !!!il est tard hein

bon c'est pas grave

je repete

bloque cette ligne avec un apostrophe

Code:

.cells(lignevide,1).resize(1,9)=tablo

et juste au dessus de la ligne ajoute la ligne du msgbox que t'ai donné avant et dis moi ce que dit MON MESSAGE!!!! pas le message d'erreur
14/11/2014, 22h49
Xenna77

:oops: SORRY!

Ligne vide = 1

1: YBH (c'est le contenu de ma cellule I2 de ma feuille principale)

Merci

donc mis a part le fait que tu te retrouve avec la valeur de la cellules 12 ce n'est pas mon tablo qui génère l'erreur
bien que 12 je comprend pas je la prend pas dans le tablo c'est bizarre
peut être pour des protéger il faut activer je vais modifier

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim derLig As Long, lignVide As Long, tablo(1, 9) As Variant, doublon As Variant
    ici j 'ai reuni les 2 conditions de sortie de sub
    If Target.Column <> 12 Or Target.Row <> Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
 
    derLig = ActiveCell.Row ' ici si on est pas sorti alors on est forcement sur la dernière ligne
 
   If ActiveCell = "RP" Then
        'doublon va devenir la celle qui contient le doublon
        Set doublon = Range("A1:A" & derLig - 1).Find(Cells(derLig, 1), LookIn:=xlValues)
        If Not doublon Is Nothing Then ' si le doublon n'est pas rien alors message
        MsgBox "il y deja cette valeur en ligne :" & doublon.Row
        Else
        ' sinon on fait le boulot et sans tout ces activate qui paralysent le system
        'il y a 7 valeurs que l'on met dans la variables tablo dans les meme colonne que les colonne du  (sheets"GM")qui est la destination
        tablo(1, 1) = Cells(derLig, 1): tablo(1, 2) = Cells(derLig, 4): tablo(1, 4) = Cells(derLig, 11)
        tablo(1, 5) = Cells(derLig, 2): tablo(1, 8) = Cells(derLig, 9): tablo(1, 9) = Cells(derLig, 9)
        With Worksheets("GM")
            .Activate
            .Unprotect Password:="XENNA" ' on déprotège le sheets
            lignVide = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' on cherche la première ligne vide en partant d'en bas
            Cells(lignevide, 1).Resize(1, 9) = tablo ' et enfin on repose le tablo (plus communément appelé "TRANSPOSE")
            .Protect Password:="XENNA"
        End With
    End If
    End If
End Sub

mais je reste perplexe pour le 12

14/11/2014, 23h05
Xenna77

:oops: pas 12 , COLONNE I LIGNE 2 -> c'est la colonne 9.

Je dois améliorer mon café virtuel :mouarf:
14/11/2014, 23h09
patricktoulon

re

et puis il est tard hein!!!!!!:mouarf:

a force de trop :pc:on fait des bêtises
14/11/2014, 23h28
patricktoulon

RE

JE SUIS MORT DE RIRE ET DE HONTE SURTOUT
dans la ligne en cause il y a "Cells(lignevide........."
hors c'est "Cells(lignvide.........."

bon je vais me coucher la parce que ca va plus :mouarf::mouarf::mouarf:

autant pour moi :mouarf:
14/11/2014, 23h42
Xenna77

Moi aussi car ca ne va plus ... Bonne nuit et merci quand même pour ton aide ...:zzz:

Une version qui fonctionne

salut

ouais ya des soir ou il faudrait se coucher de plus bonne heure hein!!!

bon c'est moi qui avais déraillé

en fait on se servait de activecell hors activecell était la cellule en dessous de la concernée puisque pour déclencher l'évènement il faut au minimum appuyer sur enter

en fait il fallait se servir de target.row tout le long
bon voila ca marche

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim derLig As Long, lignVide As Long, tablo(1, 9), doublon As Variant
    ' ici j 'ai reuni les 2 conditions de sortie de sub
    If Target.Column <> 12 Or Target.Row <> Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
    derLig = Target.Row    ' ici si on est pas sorti alors on est forcement sur la dernière ligne
        If Target = "RP" Then
        'doublon va devenir la celle qui contient le doublon
        Set doublon = Sheets(1).Range("a1:a" & Target.Row - 1).Find(Cells(derLig, 1).Value, LookIn:=xlValues)
        If Not doublon Is Nothing Then  ' si le doublon n'est pas rien alors message
            MsgBox "il y deja cette valeur en ligne :" & doublon.Row
        Else
            ' sinon on fait le boulot et sans tout ces activate qui paralysent le system
            'il y a 7 valeurs que l'on met dans la variables tablo dans les meme colonne que les colonne du  (sheets"GM")qui est la destination
            tablo(1, 1) = Cells(derLig, 1): tablo(1, 2) = Cells(derLig, 4): tablo(1, 4) = Cells(derLig, 11)
            tablo(1, 5) = Cells(derLig, 2): tablo(1, 8) = Cells(derLig, 8): tablo(1, 9) = Cells(derLig, 9)
            With Worksheets("GM")
                .Activate
                .Unprotect Password:="XENNA"    ' on déprotège le sheets
                lignVide = IIf(.Range("A" & Rows.Count).End(xlUp).Row = 1, .Range("A" & Rows.Count).End(xlUp).Row, .Range("A" & Rows.Count).End(xlUp).Row + 1) ' on cherche la première ligne vide en partant d'en bas
                .Cells(lignVide, 1).Resize(1, 9) = tablo    ' et enfin on repose le tablo (plus communément appelé "TRANSPOSE")
                .Protect Password:="XENNA"
            End With
        End If
    End If
End Sub

Voir 40 message(s) de cette discussion en une page