[VBA-EXCEL]-condition pour ouvrir une msgbox
je n'arrive pas à appliquer une condition à l'ouverture de la msgbox!
Dans le code suivant s il n y a pas de doublons, je voudrai que la msgbox ne s ouvre pas
merci d'avance
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
| Option Explicit
Option Base 1
Sub listeDoublons()
Dim Plage As Range
Dim Tableau(), Resultat() As String
Dim i As Integer, j As Integer, m As Integer
Dim Un As Collection
Dim Doublons As String
Set Un = New Collection
'La plage de cellules à tester
Set Plage = Range("A1:A" & Range("A65536").End(xlUp).Row)
Tableau = Plage.Value
ReDim Preserve Resultat(2, 1)
On Error Resume Next
'boucle sur la plage à tester
For i = 1 To Plage.Count
'Utilise une collection pour rechercher les doublons
'(les collections n'acceptent que des données uniques)
Un.Add Tableau(i, 1), Tableau(i, 1)
'S'il y a une erreur (donc presence d'un doublon)
If Err <> 0 Then
'boucle sur le tableau des doublons pour verifier s'il a deja
'été identifié
For j = 1 To m + 1
'Si oui , on incrément le compteur
If Resultat(1, j) = Tableau(i, 1) Then
Resultat(2, j) = Resultat(2, j) + 1
Err.Clear
Exit For
End If
Next j
'Si non, on ajoute le doublon dans le tableau
If Err <> 0 Then
Resultat(1, m + 1) = Tableau(i, 1)
Resultat(2, m + 1) = 1
m = m + 1
Err.Clear
ReDim Preserve Resultat(2, m + 1)
End If
End If
Next i
'----- Affiche la liste et le nombre de doublons --------
For j = 1 To m
Doublons = Doublons & Resultat(1, j) & "-->" & _
Resultat(2, j) & vbCrLf
Next j
MsgBox Doublons
End Sub |
