[XL-2003] Macro pour gerer les doublons VBA

2 pièce(s) jointe(s)

Macro pour gerer les doublons VBA

Bonjour à tous.

Je viens vous solliciter car j’ai besoin d’une aide assez urgente.
Je crée un formulaire pour gérer un tableau.
Exemple :
Pièce jointe 170687

Pièce jointe 170689

J’espère que vous arrivez à me suivre !

J'essaie de le coder avec des conditions If mais cela ne marche pas.

Si besoin je peux vous transmettre le code.

Merci d'avance de vos réponses :) !

Citation:

Envoyé par Aetycc

J'essaie de le coder avec des conditions If mais cela ne marche pas.
Si besoin je peux vous transmettre le code.

Ca serait bien, oui. Parce que "cela ne marche pas", c'est un peu léger pour trouver où se trouve ton problème.

Excuse de ne pas avoir répondu à temps.

Je m'excuse de ne pas avoir répondu à temps.
Ci-dessous le code.

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
Option Explicit
Dim Ws As Worksheet
 
 
Private Sub UserForm_Initialize()
Dim J As Long
Dim i As Integer
Dim k As Integer
Dim o As Integer
 
  Set Ws = Sheets("Base")
  With Me.ComboBox1
    For J = 2 To Ws.Range("C" & Rows.Count).End(xlUp).Row
      .AddItem Ws.Range("C" & J)
    Next J
  End With
 
  With Me.ComboBox3
  .AddItem "Etudiant"
.AddItem "Salarié"
.AddItem "Chercheur"
.AddItem "Chef"
.AddItem "Enseignant"
 
  End With
 
End Sub
'Correspond au programme de la LISTE DEROULANTE
Private Sub ComboBox1_Change()
Dim Ligne As Long
Dim i As Integer
Dim k As Integer
Dim o As Integer
 
 
   If Me.ComboBox1.ListIndex = -1 Then Exit Sub
  Ligne = Me.ComboBox1.ListIndex + 2
 
End Sub
 
 
Private Sub CommandButton3_Click()
Dim L As Integer
Dim v As Long
Dim i As Integer
 
'------------------ conditions----------------------------------------------------------------
Dim ligb As Integer, ligc As Integer, a As Integer, b As Integer, c As Integer
 
ligb = Range("A65536").End(xlUp).Row
ligc = Range("B65536").End(xlUp).Row
'---------------------fin condition---------------------------------
 
If MsgBox("Do you want to insert this line ?", vbYesNo, "Demande de confirmation") = vbYes Then
L = Sheets("Base").Range("C65536").End(xlUp).Row + 1
 
Sheets("Base").Range("C" & L).Value = ComboBox1
 
 
For i = 1 To L
If Val(Saisie.ComboBox1.Value) = Sheets("Base").Range("C" & L - 1).Value Then Sheets("Base").Range("P" & L).Value = "Ancien"
 
If Val(Saisie.ComboBox1.Value) <> Sheets("Base").Range("C" & L - 1).Value Then Sheets("Base").Range("P" & L).Value = "Nouveau"
GoTo fini:
Next
fini:
 
 
'--------------------condition colonne --------------------------------------
 
 
b = IsNumeric(Range("A" & ligb))
 
c = IsNumeric(Range("B" & ligc))
 
 
If Me.ComboBox3.Value = ("Etudiant" Or "Salarié" Or "Enseignant") Then
Range("B" & ligc + 1) = "FR-" & b + 1 & "-" & 1
Else
 
Range("A" & b + 1) = "FR-" & b & "-" & b + 1
End If
Range("A" & ligb + 1) = b + 1
'--------------------Fin condition colonne ----------------------------------------
 
MsgBox ("Line has been added successfully !") '
Else
 
 
MsgBox (" Bye !")
End If
 
 
 
 
 
Unload Me
Saisie.Show
End Sub
 
 
 
'------------------------------Test pour gerer les doublons --------------------------------------
 
Sub doublon()
 
 
    Dim Plage As Range
 
 
    With Worksheets("Base")
 
          Set Plage = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
 
    End With
 
 
     For Each ComboBox1.Value In Plage
 
        If Application.CountIf(Plage, ComboBox1.Value) > 1 Then
 
            MsgBox "Attention, la valeur '" & ComboBox1.Value & "' est en doublon," _
                   & " veuillez éliminer manuellement le double situé en '" & ComboBox1.Address(0, 0) _
                   & "' avant de pouvoir exporter les données !"
 
            ComboBox1.Interior.ColorIndex = 3
 
        End If
 
 
 
End Sub

J'ai mis des tests un peu partout ! :(

Y'a t-il une solution plus facile sans passer par des if ?

1 pièce(s) jointe(s)

Erreur de code

J'ai réussi à trouver une solution (qui marche à 96%) et je pense qu'avec le fichier Excel ça sera beaucoup plus facile à comprendre.

Le bon code est dans ce fichier excel.