Discussion :

[toctoc]

Bonjour,

Je voulais faire une petit gestion stock.
Userform1 a 2: textbox1 et textbox2.
Textbox1=Réf
Textbox2=Désignation produit.
le contenu du Textbox1 et 2 seront enregistrés dans
feuill1 colonne A2-A15 et colonne B2-B15.

La question est :Comment peut on faire pour éviter ou détecter de doublon lors du saisi de référence depuis userform1 en Vba.

Vraiment débutant dans VBA excel.

Merci pour l'aide.

[Invité]

Bonjour,
Pour ceux qui ne me connaîtraient pas quand je pars dans mes délires, je vous propose la méthode Highlander dans sa version la plus aboutie.

La plus part de mes contemporains, et ce n’est pas péjoratif, utilise une double boucle imbriquée.

Boucle A partant de 1 à n et la boucle B partant de A +1 à n. ce genre de boucle effectue 90 parcours d’une feuille Excel de 10 lignes et 9000 pour un tableau de 100 lignes, c’est l’escalade dans violence.

La méthode Highlander, il ne peut en rester qu'un. Ne vas pas rechercher les doublons, mais tel un check pont, identifie les individus passant à plusieurs reprises devant le poste de garde.

Comme vous pourrez le voir dans les différents exemples, montres que la méthode Highlander, est conviviale, adaptable et d’une facilitée d’utilisation déconcertante.

Suivant la formule consacré, Mesdames, Mesdemoiselles, Messieurs amusez vous bien.

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
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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
 
Function Highlander(Init As Boolean, ParamArray Plage()) As Boolean
'..................................................
'La méthode Highlander, il ne peut en rester qu'un.
'Retourne True si doublon.
'..................................................
 
Static CollectDoublon As Collection
Dim T As String
Dim PlageIndex As Long
Dim myPlage As Range
Dim Col As Integer
Dim Tableau
If Init = False Then
Init = True
   Set CollectDoublon = Nothing
   Set CollectDoublon = New Collection
End If
 
 
T = "T"
For PlageIndex = 0 To UBound(Plage)
If TypeName(Plage(PlageIndex)) = "Range" Then
       Set myPlage = Plage(PlageIndex)
 
       For Col = 1 To myPlage.Columns.Count
        T = T & "_" & Trim("" & myPlage(1, Col))
       Next
    Else
        If TypeName(Plage(PlageIndex)) = "Variant()" Then
           Tableau = Plage(PlageIndex)
        Else
            If TypeName(Plage(PlageIndex)) Like "*()" Then
                Tableau = Plage(PlageIndex)
            Else
                Tableau = Split(Plage(PlageIndex) & ";", ";")
            End If
        End If
         For Col = 0 To UBound(Tableau)
           If Trim("" & Tableau(Col)) <> "" Then T = T & "_" & Trim("" & Tableau(Col))
         Next
    End If
Next
On Error Resume Next
CollectDoublon.Add T, T
If Err <> 0 Then Highlander = True
On Error GoTo 0
End Function
Sub test()
Dim Init As Boolean
Dim MyRange As Range
Dim L As Long
 
Set MyRange = ActiveSheet.UsedRange
Debug.Print "********************"
Debug.Print "Sur une colonne"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, MyRange(L, 1))
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur Deux colonnes"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, MyRange(L, 1), MyRange(L, 3))
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur une plage colonne"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, ActiveSheet.Range(MyRange(L, 1), MyRange(L, 2)))
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur deux plage colonne"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, ActiveSheet.Range(MyRange(L, 1), MyRange(L, 2)), ActiveSheet.Range(MyRange(L, 3), MyRange(L, 4)))
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur (une plage colonne) et 3 collones"
For L = 1 To MyRange.Rows.Count
    If Highlander(Init, ActiveSheet.Range(MyRange(L, 1), MyRange(L, 2)), MyRange(L, 3), MyRange(L, 4), MyRange(L, 5)) = True Then Debug.Print "Doublon"
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur 1 Text"
For L = 1 To 10
    Debug.Print Highlander(Init, "Test")
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur 2 Text"
For L = 1 To 10
    Debug.Print Highlander(Init, "Test", "test")
Next
Init = False
Debug.Print "********************"
Debug.Print "Sur un Text et une colone"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, "test", MyRange(L, 1))
Next
'***************************************************
'Dans cet exemple nous allons dé-doublonner en fonction de la colonne A :
Dim Supp() As Long
Dim IdSupp As Long
ReDim Supp(IdSupp)
Init = False
For L = 1 To MyRange.Rows.Count
    If Highlander(Init, MyRange(L, 1)) = True Then
        IdSupp = IdSupp + 1
        ReDim Preserve Supp(IdSupp)
        Supp(IdSupp) = L
    End If
Next
For L = UBound(Supp) To 1 Step -1
    MyRange(Supp(L), 1).EntireRow.Delete
Next
'***************************************************
'Dé-doublonnage d'un fichier CSV avant import :
Dim NumFichier As Integer
NumFichier = FreeFile
Dim TextLine
Init = False
 
Open "c:\MyRepp\My.csv" For Input As #NumFichier    ' Ouvre le fichier.
Do While Not EOF(NumFichier)    ' Effectue la boucle jusqu'à la fin du fichier.
    Line Input #NumFichier, TextLine        ' Lit la ligne dans la variable.
    TextLine = Split(TextLine, ";")
    If Highlander(Init, TextLine) = False Then
        L = ActiveSheet.UsedRange.Rows.Count + 1
        ActiveSheet.Range(ActiveSheet.Cells(L, 1), ActiveSheet.Cells(L, UBound(TextLine) + 1)) = TextLine
     End If
Loop
Close #NumFichier    ' Ferme le fichier.
'***************************************************
'Vérification de l'existant avant import CSV
Init = False
Set MyRange = ActiveSheet.UsedRange
Debug.Print "********************"
Debug.Print "Sur une colonne"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, MyRange.Range(MyRange(L, 1), MyRange(L, MyRange.Columns.Count)))
Next
 
Open "c:\MyRepp\My.csv" For Input As #NumFichier    ' Ouvre le fichier.
Do While Not EOF(NumFichier)    ' Effectue la boucle jusqu'à la fin du fichier.
    Line Input #NumFichier, TextLine        ' Lit la ligne dans la variable.
    TextLine = Split(TextLine, ";")
    If Highlander(Init, TextLine) = False Then
        L = ActiveSheet.UsedRange.Rows.Count + 1
        ActiveSheet.Range(ActiveSheet.Cells(L, 1), ActiveSheet.Cells(L, UBound(TextLine) + 1)) = TextLine
     End If
Loop
Close #NumFichier    ' Ferme le fichier.
 
End Sub

N’oubliez pas le guide

[Marc-L]

Mac Leod a encore frappé !

[Invité]

j'aimerai que la méthode Highlander soit plus connue que Microsoft

en plus elle s'adapte à beaucoup de cas, et celui ci également.

[toctoc]

Merci pour les réponses, mais comme tout débutant ceci est un peu compliqué la méthode highlander. Je ne sais pas si mes explications sont bien compris ou pas.
Mais avec l'exemple ce sera peut être plus simple.

Comment je peux éviter lors de la saisi dans colonne Référence qu'il m'informe que le numéro existe déjà ?

Merci d'avance pour tous réponses.

[Invité]

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
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
Private Sub CheckDoublon_Click()
 
Dim emptyRow As Long
Dim suite As Long
Dim MyRange As Range
Dim Init As Boolean
'Make Sheet3 Active
Sheets(2).Activate
Dim L As Long
Set MyRange = Sheets(2).UsedRange
For L = 2 To MyRange.Rows.Count
    Highlander Init, MyRange(L, 1)
Next
'Determine EmptyRow
 
If Highlander(Init, TextBox1.Value) = False Then
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
 
'Export Data to worksheet
Cells(emptyRow, 1).Value = TextBox1.Value
Cells(emptyRow, 2).Value = TextBox2.Value
  Else
     MsgBox "Le N° " & TextBox1.Value & " exite déjà", vbExclamation
End If
If MsgBox("voulez-vous saisir un autre produit ?", vbYesNo + vbQuestion)= vbYes then
Sheets(2).Activate
Else
Unload UserForm1
End If
 
End Sub
 
Private Sub Fermer_Click()
Unload UserForm1
End Sub
 
Function Highlander(Init As Boolean, ParamArray Plage()) As Boolean
'..................................................
'La méthode Highlander, il ne peut en rester qu'un.
'Retourne True si doublon.
'..................................................
 
Static CollectDoublon As Collection
Dim T As String
Dim PlageIndex As Long
Dim myPlage As Range
Dim Col As Integer
Dim Tableau
If Init = False Then
Init = True
   Set CollectDoublon = Nothing
   Set CollectDoublon = New Collection
End If
 
 
T = "T"
For PlageIndex = 0 To UBound(Plage)
If TypeName(Plage(PlageIndex)) = "Range" Then
       Set myPlage = Plage(PlageIndex)
 
       For Col = 1 To myPlage.Columns.Count
        T = T & "_" & Trim("" & myPlage(1, Col))
       Next
    Else
        If TypeName(Plage(PlageIndex)) = "Variant()" Then
           Tableau = Plage(PlageIndex)
        Else
            If TypeName(Plage(PlageIndex)) Like "*()" Then
                Tableau = Plage(PlageIndex)
            Else
                Tableau = Split(Plage(PlageIndex) & ";", ";")
            End If
        End If
         For Col = 0 To UBound(Tableau)
         If Trim("" & Tableau(Col)) <> "" Then T = T & "_" & Trim("" & Tableau(Col))
         Next
    End If
Next
On Error Resume Next
CollectDoublon.Add T, T
If Err <> 0 Then Highlander = True
On Error GoTo 0
End Function