Discussion :

[Invité]

Bonjour à tous,

Je suis en train de faire un gestionnaire de remorque et j'aurais besoin de créer une fonction me permettant de rechercher un doublon et de supprimer toute la ligne en question.

Je pense qu'il faut utiliser une recherche v mais je ne sais pas trop ...

Si vous avez des idées, je prend

[mercatog]

Quelle est ta version d'Excel?

[Invité]

Excel 2007

J'ai également un problème lié à une limitation des caractères choisies, j'arrive à détecter quand l'utilisateur utilise un mauvais caractère, lui envoyé un message d'avertissement mais lorsque je demande d'effacer la saisie cela ne fonctionne pas et le caractère est toujours présent :s

Voici mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
If Not (KeyAscii = 32 Or KeyAscii = 45 Or (KeyAscii >= 48 And KeyAscii <= 57) Or (KeyAscii >= 65 And KeyAscii <= 122)) Then
    Reponse = MsgBox("Le caractère " & Chr(KeyAscii) & " n'est pas autorisé !" & vbCrLf & "Il ne sera donc pas validé.", vbExclamation + vbOKOnly, "Attention")
    F_PositionnerRemorque.B_Immatriculation = ""
End If

Or la textbox B_Immatriculation reste pleine même lorsqu'il y a une erreur ...

[mercatog]

Onglet Données > Rubrique Outils de Données > Supprimer les doublons.

En vba regarde l'aide sur RemoveDuplicates

[Invité]

Merci beaucoup !
Je vais regarde cela et je reviens vers toi :p

Une idée sur mon autre problème qui n'efface pas le texte lorsqu'il y a une erreur ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
If Not (KeyAscii = 32 Or KeyAscii = 45 Or (KeyAscii >= 48 And KeyAscii <= 57) Or (KeyAscii >= 65 And KeyAscii <= 122)) Then
    Reponse = MsgBox("Le caractère " & Chr(KeyAscii) & " n'est pas autorisé !" & vbCrLf & "Il ne sera donc pas validé.", vbExclamation + vbOKOnly, "Attention")
    F_PositionnerRemorque.B_Immatriculation = ""
End If

[mercatog]

Un sujet par post (règlement du forum oblige)
Ouvre un nouvel sujet avec ta question.

[Invité]

J'ai un problème avec le code suivant, la fonction RemoveDuplicates marche super bien, seulement je n'arrive pas à copier la plage de donnée épurée des doublons et la coller dans la feuille "Données" puis repasser un coup d'anti doublon.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 CommandButton1_Click()
Sheets("MiseAJour").select
'Supression des doublons
    ActiveSheet.Range("$A$4:$A$10000").RemoveDuplicates Columns:=Array(1), _
        Header:=xlYes
 
'Copie des valeurs
Range("A4").Select
 
Do While Not (IsEmpty(ActiveCell))
    NbLigne = NbLigne + 1
    Selection.Offset(1, 0).Select
Loop
 
    Selection.Copy
 
'Ecriture dans la base de donnée
Sheets("Données").Select
Range("A2").Select
 
Do While Not (IsEmpty(ActiveCell))
    NbLigne = NbLigne + 1
    Selection.Offset(1, 0).Select
Loop
 
    ActiveSheet.Paste
 
'Supression des doublons
    ActiveSheet.Range("$A$2:$A$10000").RemoveDuplicates Columns:=Array(1), _
        Header:=xlYes
 
End Sub

Le problème (Erreur 1004) apparaît au niveau du Range("A2") alors que j'ai bien selectionné la feuille avant, je ne comprend pas ...

[Philippe Tulliez]

Bonjour,
Si tu dois Copier/Coller sans les doublons à un autre endroit, regarde du côté de l'outil Filtre avancé appelé aussi Filtre élaborés.

[Invité]

L'option filtre avancé ne fonctionne que pour la feuille active, or je souhaite coller cette liste dans une feuille.

Je vais continuer à bosser sur mon code

[Philippe Tulliez]

Bonjour,
Non, l'outil filtre avancé fonctionne sur plusieurs feuilles.
Si tu le fais sans VBA et que tu veux exporter vers une autre feuille que la source, tu dois lancer le filtre avancé depuis la feuille de destination. Je sais c'est curieux mais c'est comme cela.
Pour revenir à ce qui te préoccupe.
Voici un code à adapter, j'ai fait cela rapidement ce n'est pas très propre.
Il faut juste changer les noms des feuilles et l'adresse des Range

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub t()
 Dim shtFrom As Worksheet, shtTo As Worksheet
 Set shtFrom = Worksheets("db")
 Set shtTo = WorkSheets("Export")
 SupprimeDoublon shtFrom.Range("K1:K106"), shtTo.Range("A2")
End Sub
Sub SupprimeDoublon(rngFrom As Range, rngTo As Range)
 ' Supression des doublons
 rngFrom.RemoveDuplicates Columns:=Array(1), Header:=xlYes
 'Copie des valeurs
 rngFrom.CurrentRegion.Copy rngTo
End Sub

[Invité]

Merci pour ton aide.

Je ne comprend pas le code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 shtTo.Range("A2")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 rngFrom.CurrentRegion.Copy rngTo

J'ai copié le code en changeant les noms de feuilles et les ranges mais je n'arrive pas à avoir ce que je veux.
En effet la taille des données à trier peut être amener à évoluer, pour cela que j'avais créer une fonction recherche pour trouver la dernière ligne et trier/copier uniquement les données dont j'avais besoin.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub t()
 Dim shtFrom As Worksheet, shtTo As Worksheet
 Set shtFrom = Worksheets("MiseAJour")
 Set shtTo = Worksheets("Données")
 SupprimeDoublon shtFrom.Range("A1:A10000"), shtTo.Range("A2")
End Sub
Sub SupprimeDoublon(rngFrom As Range, rngTo As Range)
 ' Supression des doublons
 rngFrom.RemoveDuplicates Columns:=Array(1), Header:=xlYes
 'Copie des valeurs
 rngFrom.CurrentRegion.Copy rngTo
End Sub

J'ai retravaillé mon code, j'arrive à copier la selection que je veux mais je n'arrive pas à la coller sur l'autre feuille. Je n'ai que l'option pastespecial de disponible et non l'option paste. Rha j'y suis presque !!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
33
34
 
Private Sub CommandButton1_Click()
Sheets("MiseAJour").Select
'Supression des doublons
    ActiveSheet.Range("$A$4:$A$10000").RemoveDuplicates Columns:=Array(1), _
        Header:=xlYes
 
'Copie des valeurs
Range("A4").Select
 
Ligne = 4
Do Until IsEmpty(Range("A" & Ligne))
    Ligne = Ligne + 1
Loop
 
dernièreLigne = Ligne - 1
Range("A4:A" & dernièreLigne).Copy
 
 
'Ecriture dans la base de donnée
Sheets("Données").Select
 
Ligne = 2
Do Until IsEmpty(Range("A" & Ligne))
    Ligne = Ligne + 1
Loop
 
Range("A" & Ligne).PasteSpecial
 
'Supression des doublons
    ActiveSheet.Range("$A$2:$A$10000").RemoveDuplicates Columns:=Array(1), _
        Header:=xlYes
 
End Sub

[Philippe Tulliez]

Bonjour,

Merci pour ton aide.
Je ne comprend pas le code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 shtTo.Range("A2")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 rngFrom.CurrentRegion.Copy rngTo

shtTo et shtFrom sont des variables objets qui représentent les feuilles.
Leurs valeurs sont affectées par l'instruction Set

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set shtFrom = Worksheets("MiseAJour")
Set shtTo = Worksheets("Données")

Pour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rngFrom.CurrentRegion.Copy rngTo

C'est copier la plage où les doublons sont supprimés vers la feuille de destination mais je viens de me rendre compte que je me suis effectivement trompé. Je reviens avec le code corrigé. Voilà ce qui arrive quand on programme trop vite.
rngForm est l'argument Range que l'on passe à la procédure SupprimeDoublon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

SupprimeDoublon shtFrom.Range("A1:A10000"), shtTo.Range("A2")

Soit shtFrom.Range("A1:A10000")
Pour prendre toute une plage, j'utilise pratiquement toujours CurrentRegion (cela équivaut presque à faire un Ctrl + A.

[Philippe Tulliez]

Bonjour,
Maintenant cela devrait fonctionner. Ce qui est en rouge a été modifié.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub SupprimeDoublon(rngFrom As Range, rngTo As Range)
 ' Supression des doublons
 rngFrom.RemoveDuplicates Columns:=Array(1), Header:=xlYes
 'Copie des valeurs
 rngFrom.Parent.Range(rngFrom(1).Address, rngFrom.End(xlDown)).Copy rngTo
End Sub

[EDIT]
Attention, j'ai ajouté un bout de code à la ligne de la procédure que je viens de déposer afin que cela fonctionne quelle que soit la feuille où on est.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rngFrom.Parent.Range(rngFrom(1).Address, rngFrom.End(xlDown)).Copy rngTo

[Invité]

Cela marche, merci beaucoup

édit: En faite, le programme ne fait pas exactement ce que je veux, j'aurais souhaité que les valeurs copier se rajoute après une plage de valeur en cherchant la dernière ligne, or là il se colle directement dés la cellule A2 qu'elle soit occupée ou non.

Autre soucis, avec le code que tu m'as passé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub SupprimeDoublon(rngFrom As Range, rngTo As Range)
 ' Supression des doublons
 rngFrom.RemoveDuplicates Columns:=Array(1), Header:=xlYes
 'Copie des valeurs
 rngFrom.Parent.Range(rngFrom(1).Address, rngFrom.End(xlDown)).Copy rngTo
 
Sheets("Données").Select
    ActiveSheet.Range("$A$1:$A$10000").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
Private Sub MiseAJour_Click()
 Dim shtFrom As Worksheet, shtTo As Worksheet
 Set shtFrom = Worksheets("MiseAJour")
 Set shtTo = Worksheets("Données")
 SupprimeDoublon shtFrom.Range("A4:A10000"), shtTo.Range("A2")
End Sub

Dans la feuille ou on cherche à supprimer les doublons au début, cela ne fonctionne pas correctement, il me reste toujours 1 doublon.
Ma liste commence à partir de la cellule A4, et après l'activation du programme, il me reste une valeur en A4 et une en A5 qui sont identiques

[Philippe Tulliez]

Bonjour,

Cela marche, merci beaucoup
édit: En faite, le programme ne fait pas exactement ce que je veux, j'aurais souhaité que les valeurs copier se rajoute après une plage de valeur en cherchant la dernière ligne, or là il se colle directement dés la cellule A2 qu'elle soit occupée ou non.

Je n'ai lu nulle part, que tu voulais placer la liste à la suite d'une autre. Je ne pouvais pas le "devinez"
Il te suffit donc de lui donner une autre adresse, en recalculant la dernière ligne occupée si A10 est rempli.
Une solution parmi d'autres Mais attention l'étiquette de colonne est copiée également.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub t()
 Dim shtFrom As Worksheet, shtTo As Worksheet
 Dim adrTo As String: adrTo = "A10"
 Dim nbRow As Long
 With ThisWorkbook
  Set shtFrom = Worksheets("db")
  Set shtTo = Worksheets("Export")
 End With
 With shtTo
  nbRow = IIf(Len(.Range(adrTo)), .Range(adrTo).CurrentRegion.Rows.Count, 0)
 End With
 SupprimeDoublon shtFrom.Range("j1:J106"), shtTo.Range(adrTo).Offset(nbRow)
End Sub

Autre soucis, avec le code que tu m'as passé
Dans la feuille ou on cherche à supprimer les doublons au début, cela ne fonctionne pas correctement, il me reste toujours 1 doublon.
Ma liste commence à partir de la cellule A4, et après l'activation du programme, il me reste une valeur en A4 et une en A5 qui sont identiques

Si tu le fais à la main, tu auras le même résultat.
Avec l'argument Header:=xlYes il est normal que si en A4, ce n'est pas le titre, le programme ne le sais pas. Encore une fois devinez n'est pas le fort de la programmation
Donc si tu donne comme adresse la première cellule qui n'est pas l'étiquette de colonne, il faut changer la valeur de cet argument.

[Invité]

Merci pour ton aide

Je voulais savoir si il était possible de copier une liste puis ensuite d'enlever les doublons au lieu d'enlever les doublons puis de copier.

Je voulais savoir aussi si il était possible d'adapter une rowsource pour un combobox en fonction du nombre de ligne présente.
Car là j'ai mis des rowsource avec beaucoup de ligne et la scrollbare de la liste déroulant ne sert pas au final :s

édit: Trouver pour row source

[Philippe Tulliez]

Bonjour,

Je voulais savoir si il était possible de copier une liste puis ensuite d'enlever les doublons au lieu d'enlever les doublons puis de copier.

En programmation tout est possible, c'est une question de temps et de moyens.
Il suffit de copier la colonne d'un endroit A vers un endroit B et appliquer la suppression à cet endroit.

[Invité]

Ce que j'aime à penser

J'ai essayé de coder cela mais cela ne fonctionne pas, il me note " Objet requis"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub MiseAJourUtilisateur()
 
Sheets("Base").Select
     'Boucle pour trouver la ligne vide
Ligne = 5
Do Until IsEmpty(Range("A" & Ligne))
    Ligne = Ligne + 1
Loop
 
Immatriculation = Range("A5:A" & Ligne)
Immatriculation.Copy
 
Sheets("Programme").Select
Activesheets.Paste
 
 
End Sub

[Philippe Tulliez]

Bonjour,
Un petit peu de lecture ici et tout particulièrement ce chapitre. Quelques tests et la compréhension suivra.

[Invité]

Merci pour le lien, j'irais regardé demain matin, là j'arrive plus trop à me concentrer ^^

J'ai rencontré le problème suivant, cette fois-ci, il est un peu étrange.
Voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
    With ActiveWorkbook.Worksheets("Données").Sort
        .SetRange Range("G2:G10000")
        .Header = xlNo
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Il me permet de réorganiser une liste de chiffres mais surtout d'éviter qu'il y ai des lignes vides car l'utilisateur a en effet la possibilité de supprimer des informations, ce qui cré des lignes vide.
Le code marche très bien pour une seule liste. Si je demande de réorganiser une autre liste en changeant les variables cela ne marche pas.

Je pense que c'est dû à la fonction "set" que je ne comprend pas encore exactement, j'irais regarder demain matin.
SI tu souhaites me donner des pistes, je suis preneur.

Je tenais à te remercier pour toute l'aide que tu m'apportes, cela m'aide beaucoup

Bonne soirée à toi

édit: J'ai trouvé pour mon problème de tri, j'ai rajouté les lignes suivantes juste avant et cela marche. Je ne sais cependant pas pourquoi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
    Sheets("Données").Activate
    Sheets("Données").Range("C2:C10000").Sort key1:=Sheets("Données").Range("C2"), order1:=xlAscending
 
    With ActiveWorkbook.Worksheets("Données").Sort
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With