jeudi 11 avril 2024
dimanche 12 février 2023
كود vba xls لإرسال البريد الإلكتروني
فيما يلي مثال على رمز VBA لإرسال بريد إلكتروني من Microsoft Excel باستخدام Microsoft Outlook كعميل بريد إلكتروني:
Sub EnvoyerEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim Destinataire As String
Dim Sujet As String
Dim Corps As String
Destinataire = "adresse_email@exemple.com"
Sujet = "Objet de l'email"
Corps = "Corps de l'email"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Destinataire
.Subject = Sujet
.Body = Corps
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
ما عليك سوى استبدال قيم المستلم والموضوع والجسم بالقيم التي تريدها لبريدك الإلكتروني وتشغيل الماكرو بالنقر فوق "تشغيل" أو الضغط على "F5".
Résuméabuiyad
samedi 22 décembre 2018
برنامج جلب مواقيت الصلاة
مع عرض كل المعلومات الخاصة بالمدينة مثل عدد البلديات، الدوائر، المساحة و عدد السكان
المصدر مفتوح و يمكن للجميع العمل على البرنامج، نرجو من الإخوى دعاء فقط
'
' Macro1 Macro
' Macro enregistrée le 10/01/2017 par CAAR
'
'
' DESACTIVER SECEEN
Application.ScreenUpdating = False
On Error Resume Next
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
' DEMasquer le Feuil 2 et 3
Sheets("Tmp").Visible = True
Sheets("Parametre").Visible = True
Sheets("M-salat").Select
Range("P9").Select
Dim nabil1 As String
Dim nabil2 As String
Sheets("M-Salat").Select
nabil1 = Range("P12")
nabil2 = Range("P12")
Sheets("Tmp").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & nabil1, Destination:=Range("A1"))
.Name = "show_prayertimes.php?city_link=constantine&box_style=2_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("A1").Select
Columns("A:A").ColumnWidth = 28.43
Range("A1:A20").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
Dim nabil10 As String
Dim nabil11 As String
Dim nabil12 As String
Dim nabil13 As String
Dim nabil14 As String
Dim nabil15 As String
Dim nabil16 As String
Dim nabil17 As String
Dim nabil18 As String
Dim nabil19 As String
Dim nabil20 As String
Sheets("Tmp").Select
nabil10 = Range("A2")
nabil11 = Range("A3")
nabil12 = Range("A4")
nabil13 = Range("A6")
nabil14 = Range("A7")
nabil15 = Range("A9")
nabil16 = Range("A11")
nabil17 = Range("A13")
nabil18 = Range("A15")
nabil19 = Range("A17")
nabil20 = Range("A19")
Sheets("M-salat").Select
Range("AC20") = nabil10
Range("AC21") = nabil11
Range("U14") = nabil12
Range("M17") = nabil13
Range("L20") = nabil14
Range("AK26") = nabil15
Range("AF26") = nabil16
Range("AA26") = nabil17
Range("V26") = nabil18
Range("Q26") = nabil19
Range("L26") = nabil20
' masquer les feuil 2+3
Sheets("Tmp").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Parametre").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("M-salat").Select
Range("P9").Select
End Sub
Résuméabuiyad
vendredi 21 décembre 2018
الدينار الجزائري بالنسبة للعملات الأخرى على الناث مباشرة
كود بيحميك من انك توقف على الخلية تريد
If Target.Column = 2 And Target.Row = 3 Then
Beep
Cells(Target.Row, Target.Column).Offset(0, 1).Select
ElseIf Target.Column = 2 And Target.Row = 6 Then
Beep
Cells(Target.Row, Target.Column).Offset(0, 1).Select
End If
End Sub
Résuméabuiyad
Apprendre comment identifier et manipuler les doublons dans les feuilles
Les exemples ont été testés avec Excel2002 et Excel2007.
I. Introduction▲
Ce tutoriel présente quelques solutions disponibles dans l'application Excel:
* Les fonctions intégrées.
* Les formules.
* Les macros.
Plusieurs exemples sont transposables dans différents chapitres et vous pourrez aisément les adapter à vos projets.
II. Les outils Excel▲
II-A. Le menu Validation: empêcher la saisie de doublons dans une plage de cellules▲
Par exemple dans Excel2002:
Sélectionnez la plage de cellules A1:A10.
Utilisez le menu Données
Option Validation
Onglet Options
Sélectionnez l'option Personnalisé dans la liste de choix.
Saisissez dans le champ Formule: =NB.SI($A$1:$A$10;A1)<2 span="">
Cliquez sur le bouton OK pour valider.
Désormais un message d'alerte s'affichera lorsque deux données identiques seront saisies dans la plage A1:A10.
Dans Excel2007, le menu validation est accessible dans l'onglet Données, groupe Outils de données.
La procédure de paramétrage reste identique.
2>
II-B. La mise en forme conditionnelle: Visualiser les doublons▲
Dans Excel 2002, la mise en forme conditionnelle est accessible par le menu Format/Mise en forme conditionnelle.
Dans Excel 2007, la mise en forme conditionnelle est accessible dans l'onglet Accueil, groupe Style.
Les critères de mise en forme peuvent être définis par des formules qui vérifieront si des données sont similaires dans la plage de cellules. Les fonctions utilisées doivent être de type logique et renvoyer un résultat Vrai ou Faux.
II-B-1. Identifier les doublons dans une colonne▲
Sélectionnez la colonne A.
Choisissez l'option "La formule est:" dans la boîte de dialogue de mise en forme conditionnelle et saisissez la formule:
=
NB.
SI
(
A:A;A1)>
1
Ensuite, cliquez sur le bouton "Format" pour définir la mise en forme.
Pour cibler uniquement les doublons, sélectionnez la colonne à partir de la cellule A2 puis utilisez la formule:
=
SOMMEPROD
(
(
$A$1
:$A1=
$A2)*
(
$A2<
>
"
"
))
II-B-2. Identifier les doublons sur plusieurs colonnes▲
Vous pouvez repérer qu'un couple Nom/Prénom se retrouve sur plusieurs lignes en appliquant une formule de mise en forme conditionnelle.
Sélectionnez la plage à tester (A2:B6 dans la capture d'écran ci-dessous), puis appliquez le critère conditionnel:
=
SOMMEPROD
(
(
$A$1
:$A1=
$A2)*
(
$B$1
:$B1=
$B2)*
(
$A2<
>
"
"
))
La ligne 5 est identifiée comme doublon car des données identiques existent déjà dans la ligne 2.
II-B-3. La mise en forme conditionnelle dans Excel 2007▲
Sélectionnez la plage de cellules à tester.
Cliquez sur l'onglet Accueil
Groupe Style
Bouton Mise en forme conditionnelle
Option Règles de mise en surbrillance des cellules
Sélectionnez Valeurs en double
Dans la boîte de dialogue, vous pouvez choisir de mettre en forme les cellules en double ou les données uniques.
Paramétrez la mise en forme associée à la condition.
Cliquez sur le bouton OK pour valider.
Tout comme dans les versions antérieures d'Excel, vous pouvez aussi toujours utiliser des formules logiques afin d'identifier des doublons:
Sélectionnez la ou les cellules.
Cliquez sur l'option Nouvelle règle dans le menu du bouton Mise en forme conditionnelle.
Sélectionnez Utiliser une formule ... dans le champ Type de règle.
Saisissez votre formule.
Choisissez le format de mise en forme (bouton Format).
Cliquez sur le bouton OK pour valider.
II-C. Le filtre élaboré▲
* Utilisez le menu Données
* Filtrer
* Filtre élaboré
Spécifiez la plage à filtrer.
Cochez l'option "Extraction sans doublons" pour éliminer les lignes en double.
Vous avez la possibilité de filtrer directement dans la plage initiale ou vers un autre emplacement dans la feuille active.
Nota:
Dans Excel 2007, le menu "filtre élaboré" est renommé "filtre avancé" et se trouve dans l'onglet Données, groupe Trier et filtrer, bouton Avancé.
II-D. Le menu 'Supprimer les doublons' Excel 2007▲
Sélectionnez la plage de cellules et cliquez sur le bouton Supprimer les doublons.
La boîte de dialogue permet de spécifier les paramètres pour la suppression des doublons:
* Précisez si la première ligne est un en-tête (Celle-ci ne sera pas prise en compte pour la suppression).
* Par défaut, toutes les colonnes de la plage sont cochées. Cela signifie que la recherche de doublon est effectuée sur des lignes complètes. Vous pouvez décocher certains champs afin d'effectuer la requête sur une ou quelques colonnes spécifiques du tableau.
Par exemple dans le tableau présenté ci dessus, si les 3 colonnes sont cochées, la fonction va supprimer la ligne 6.
Si seule la colonne "Champ1" est cochée, la fonction va supprimer les lignes 4 et 6.
III. Les formules▲
III-A. Les fonctions statistiques▲
III-A-1. Compter le nombre de valeurs identiques▲
=
SOMMEPROD
(
NB.
SI
(
A1:A10;B1:B10))
Si les cellules ne contiennent que des valeurs numériques, la fonction suivante permet de compter le nombre de valeurs identiques (uniques) entre deux plages:
=
SOMMEPROD
(
(
FREQUENCE
(
A1:A10;B1:B10)>
0
)*
1
)-
1
III-A-2. Compter le nombre de données différentes▲
=
SOMMEPROD
(
1
/
NB.
SI
(
A1:A10;A1:A10))
Un autre exemple par formule matricielle (à valider en appuyant simultanément sur les touches Ctrl + Maj + Entrée).
=
SOMME
(
SI
(
FREQUENCE
(
EQUIV
(
A1:A10;A1:A10;0
);EQUIV
(
A1:A10;A1:A10;0
))>
0
;1
))
Une autres solution, dans le cas où il y aurait des cellules vides dans la plage (A valider par Ctrl + Maj + Entrée):
=
SOMMEPROD
(
SI
(
A1:A10<
>
"
"
;1
/
NB.
SI
(
A1:A10;A1:A10)))
Les fonctions suivantes comptent le nombre de valeurs numériques différentes dans la plage A1:A10.
Remarque: La plage A1:A10 peut contenir du texte et des cellules vides.
=
SOMME
(
SI
(
FREQUENCE
(
A1:A10;A1:A10)>
0
;1
))
=
SOMME
(
N
(
FREQUENCE
(
A1:A10;A1:A10)>
0
))
Une autre possibilité par formule matricielle (à valider en appuyant simultanément sur les touches Ctrl + Maj + Entrée).
=
SOMME
(
SI
(
ESTNUM
(
A1:A10);1
/
NB.
SI
(
A1:A10;A1:A10)))
Un autre exemple qui ne prend pas en compte les 0 (Formule matricielle à valider par Ctrl + Maj + Entrée).
=
SOMME
(
SI
(
A1:A10>
0
;1
/
NB.
SI
(
A1:A10;A1:A10)))
III-A-3. Compter le nombre de doublons dans une plage▲
Cet exemple n'accepte pas les cellules vides dans la plage à contrôler.
=
NBVAL
(
A1:A10)-
SOMMEPROD
(
1
/
NB.
SI
(
A1:A10;A1:A10))
Si la plage contient des cellules vides, utilisez:
=
NBVAL
(
A1:A10)-
SOMMEPROD
(
SI
(
A1:A10<
>
"
"
;1
/
NB.
SI
(
A1:A10;A1:A10)))
Formule matricielle à valider par Ctrl + Maj + Entrée.
III-A-4. Trouver la donnée qui apparaît le plus souvent▲
=
MODE
(
A1:A10)
Une autre version qui affiche la valeur qui apparaît le plus souvent et au moins 5 fois dans la plage A1:A10:
=
SI
(
NB.
SI
(
A1:A10;MODE
(
A1:A10))>
4
;MODE
(
A1:A10);"
"
)
Pour afficher la donnée (texte ou numérique) qui apparait le plus souvent dans la plage A1:A10, utilisez:
(Formule matricielle à valider par Ctrl + Maj + Entrée).
=
INDEX
(
A1:A10;EQUIV
(
MAX
(
NB.
SI
(
A1:A10;A1:A10));NB.
SI
(
A1:A10;A1:A10);0
))
III-A-5. Compter le nombre de cellules contenant une donnée spécifique▲
=
NB.
SI
(
A:A;"
dvp
"
)
Vous pouvez aussi compter le nombre de cellules qui contient le texte DVP, uniquement quand saisi en majuscules:
=
SOMMEPROD
(
(
EXACT
(
A1:A10;"
DVP
"
)*
1
))
III-A-6. Compter les chaînes de caractères▲
Cet exemple compte le nombre de "a" dans la cellule A1:
=
NBCAR
(
A1)-
NBCAR
(
SUBSTITUE
(
A1;"
a
"
;"
"
))
Un autre exemple qui compte le nombre de chaîne "mimi" dans la cellule A1:
=
(
NBCAR
(
A1)-
NBCAR
(
SUBSTITUE
(
A1;"
mimi
"
;"
"
)))/
4
III-B. Les fonctions de recherche▲
III-B-1. Retrouver les données uniques et les doublons▲
Si par exemple les éléments à contrôler sont dans la plage A1:A20, saisissez la formule ci-dessous dans la cellule B1:
=
SI
(
NB.
SI
(
$A$1
:$A$20
;A1)>
1
;"
Multiple
"
;"
Unique
"
)
Puis, utilisez les poignées de recopie jusqu'en B20.
Si vous souhaitez identifier les doublons sur plusieurs colonnes, utilisez la fonction SOMMEPROD:
Vous avez par exemple des enregistrements sur deux colonnes (A et B), la première colonne contient des noms et la seconde contient des prénoms.
Vous pouvez repérer qu'un couple Nom/Prénom se retrouve sur plusieurs lignes en appliquant la fonction suivante dans la colonne C.
=
SI
(
SOMMEPROD
(
(
$A$1
:$A1=
$A2)*
(
$B$1
:$B1=
$B2)*
(
$A2<
>
"
"
) )=
0
;"
Unique
"
;"
Doublon
"
)
Saisissez la formule en C2, puis utilisez les poignées de recopie vers le bas.
La ligne 5 est identifiée comme doublon car des données identiques existent déjà dans la ligne 2.
Nota:
Vous remarquerez que cette dernière formule est identique au chapitre II-B-2, ceci pour montrer que les différents exemples présentés dans cette page peuvent être transposés en fonction de la méthode que vous allez mettre en oeuvre.
III-B-2. Trouver les communs entre deux plages▲
saisissez la formule suivante en C1 par exemple, puis étirez la vers le bas.
=
SI
(
NB.
SI
(
$B$1
:$B$10
;A1)>
0
;A1;"
"
)
III-B-3. Extraire les données d'une plage sans les doublons▲
saisissez en B2 cette formule matricielle (à valider par Ctrl+Maj+Entrée)
=
(
INDEX
(
$A:$A;MIN
(
SI
(
NB.
SI
(
B$1
:B1;$A$1
:$A$100
)=
0
;LIGNE
(
$A$1
:$A$100
))))&
"
"
)
Puis utilisez les poignées de recopie vers le bas.
Vous obtenez, dans la colonne B, la liste des éléments sans doublons.
Si vous souhaitez ensuite compter le nombre de fois qu'apparait chaque élément dans la colonne A, saisissez la formule suivante dans la cellule C2, puis étirez la vers le bas.
=
SI
(
B2<
>
"
"
;NB.
SI
(
A:A;B2);"
"
)
Nota:
Il ne doit pas y avoir de cellules vides entre les différentes données de la colonne A.
III-B-4. Générer une série de nombres entiers aléatoires sans doublon▲
Insérez la formule = Alea() dans la cellule A1, puis utilisez les poignées de recopie jusqu'en A25.
Saisissez les nombres 1 à 25 par ordre croissant dans la plage B1:B25
Dans la cellule C1, saisissez:
=
RECHERCHEV
(
PETITE.
VALEUR
(
$A$1
:$A$25
;LIGNE
(
));$A$1
:$B$25
;2
;0
)
Puis utilisez les poignées de recopie jusqu'en C25.
Utilisez la touche clavier F9 pour lancer un nouveau tirage.
III-C. Les fonctions logiques▲
La formule renvoie VRAI si les données des 2 plages sont identiques, et FAUX dans le cas contraire.
=
ET
(
A1:A10=
B1:B10)
III-D. Alimenter des listes de validation sans doublon▲
IV. Les macros▲
IV-A. Créer une liste sans doublons▲
Option
Explicit
Sub
Test
(
)
Creer_Liste_SansDoublons Range
(
"
A1:A20
"
)
End
Sub
Sub
Creer_Liste_SansDoublons
(
Plage As
Range)
Dim
Cell As
Range
Dim
Un As
Collection
Dim
i As
Long
Set
Un =
New
Collection
On
Error
Resume
Next
'
Boucle
sur
la
plage
de
cellule
For
Each
Cell In
Plage
'
If
Cell
<>
""
Permet
de
ne
pas
prendre
en
compte
les
cellules
vides
'
Un.Add
Cell,
CStr(Cell)
Ajoute
le
contenu
de
la
cellule
dans
la
collection
If
Cell <
>
"
"
Then
Un.
Add
Cell, CStr
(
Cell)
Next
Cell
On
Error
GoTo
0
'
Boucle
sur
les
éléments
de
la
collection.
For
i =
1
To
Un.
Count
'
Ecrit
le
résultat
dans
la
fenêtre
d'exécution
(Ctrl+G)
Debug.
Print
Un.
Item
(
i)
Next
i
Set
Un =
Nothing
End
Sub
IV-B. Quelques informations sur l'objet Collection▲
Une Collection est constituée par un groupe d'éléments, en les considérants comme un seul objet. Cet objet est facile à manipuler et très rapide d'utilisation. L'argument Key (clé) de chaque élément doit obligatoirement être unique dans la Collection et cette particularité peut être mise à profit afin d'identifier et filtrer les doublons.
Une collection peut être créée à partir de l'instruction:
Dim
Un As
Collection
Set
Un =
New
Collection
Une fois l'objet Collection créé, il est possible:
* D'ajouter des éléments à l'aide de la méthode Add.
* De supprimer des éléments au moyen de la méthode Remove.
* De compter le nombre d'éléments au moyen de la propriété Count.
La ligne de code ci-dessous montre comment ajouter des éléments dans la collection.
Un.
Add
Cell, CStr
(
Cell)
Description des arguments pour ajouter un élément dans une collection:
object.Add [item], [key], [before], [after]
[Item] est l'élément ajouté dans la collection.
[before] et [after] (Facultatifs et non utilisés ici) indiquent la position au sein de la collection.
[Key] est une clé, représentée par une chaîne unique, qui permet d'accéder à chaque élément de la collection.
La fonction de conversion Cstr permet de convertir la clé en type de donnée String (L'argument Key doit impérativement être de type String).
Une erreur apparait si une clé existe déjà dans la collection. C'est justement cette spécificité qui va être utilisée pour identifier rapidement des doublons.
Le gestionnaire d'erreur va "forcer" le passage à la ligne suivante lorsqu'une erreur survient.
On
Error
Resume
Next
'
'
Un.Add
Cell,
CStr(Cell)
'
On
Error
GoTo
0
Pour lire le contenu de la collection et donc visualiser la liste d'éléments uniques, il suffit de boucler sur les éléments de la collection:
For
i =
1
To
Un.
Count
'
Ecrit
le
résultat
dans
la
fenêtre
d'exécution
(Ctrl+G)
Debug.
Print
Un.
Item
(
i)
Next
i
Et enfin, n'oubliez pas de vider la variable en fin de procédure.
Set
Un =
Nothing
IV-C. Empêcher la saisie de doublons dans une plage de cellules▲
La procédure utilise l'évènement Worksheet_Change qui va être déclenché à chaque modification dans la feuille de calcul.
Si une donnée similaire existe déjà dans la colonne, un message d'alerte s'affiche et la saisie va être annulée.
Option
Explicit
Private
Sub
Worksheet_Change
(
ByVal
Target As
Excel.
Range
)
Dim
Colonne As
Integer
Dim
Adresse As
String
'
On
sort
si
plus
d'une
cellule
a
été
modifiée
If
Target.
Count
>
1
Then
Exit
Sub
'
On
sort
si
la
cellule
modifiée
est
vide
If
Target.
Value
=
"
"
Then
Exit
Sub
'
Définit
la
colonne
à
vérifier
(1=Colonne
A,
2=colonne
B
...etc...)
Colonne =
1
'
Vérifie
si
c'est
la
colonne
cible
a
été
modifiée
If
Target.
Column
=
Colonne Then
'
Recherche
si
la
nouvelle
donnée
existe
déjà
dans
la
colonne.
Adresse =
Columns
(
Colonne).
Find
(
What:=
Target.
Value
, After:=
Target.
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 <
>
Target.
Address
Then
MsgBox
"
La
donnée
'
"
&
Target &
"
'
existe
déjà
dans
la
cellule
"
&
Adresse
'
Suppression
de
la
donnée
Target.
Value
=
"
"
Target.
Select
End
If
End
If
End
Sub
IV-D. Compter le nombre de doublons dans une plage▲
Option
Explicit
Option
Base 1
Sub
listeDoublonsPlage
(
)
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
(sur
une
colonne)
à
tester
Set
Plage =
Range
(
"
A1:A
"
&
Range
(
"
A65536
"
).
End
(
xlUp).
Row
)
Tableau =
Plage.
Value
On
Error
Resume
Next
'
boucle
sur
la
plage
à
tester
For
i =
1
To
Plage.
Count
ReDim
Preserve
Resultat
(
2
, m +
1
)
'
Utilise
une
collection
pour
rechercher
les
doublons
'
(les
collections
n'acceptent
que
des
données
uniques)
Un.
Add
Tableau
(
i, 1
), CStr
(
Tableau
(
i, 1
))
'
S'il
y
a
une
erreur
(donc
présence
d'un
doublon)
If
Err
<
>
0
Then
'
boucle
sur
le
tableau
des
doublons
pour
vérifier
s'il
a
déjà
'
été
identifié
For
j =
1
To
m +
1
'
Si
oui,
on
incrémente
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
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
Set
Un =
Nothing
End
Sub
IV-E. Compter le nombre de données communes entre deux plages▲
Le tableau de résultat s'affiche dans la feuille nommée Feuil2.
Option
Explicit
Sub
Test
(
)
CommunsPlages_CountIf Range
(
"
A6:A25
"
), Range
(
"
B1:B17
"
)
End
Sub
'
La
procédure
recherche
et
compte
les
données
de
Plage_A
qui
apparaissent
'
aussi
dans
Plage_B
Sub
CommunsPlages_CountIf
(
Plage_A As
Range, Plage_B As
Range)
Dim
Cell As
Range
Dim
i As
Integer
, k As
Integer
Dim
Tableau
(
) As
Variant
'
boucle
sur
les
cellules
de
la
plage
Plage_A
For
Each
Cell In
Plage_A
'
Vérifie
si
la
donnée
de
Plage_A
apparait
dans
Plage_B
If
Application.
CountIf
(
Plage_B, Cell) >
0
Then
'
Redimensionne
le
tableau
de
résultats
i =
i +
1
ReDim
Preserve
Tableau
(
1
To
2
, 1
To
i)
'
Compte
le
nombre
de
fois
que
la
donnée
apparait
'
dans
Plage_B.
k =
Application.
CountIf
(
Plage_B, Cell)
'
---
Remplissage
tableau:
'
La
donnée
Tableau
(
1
, i) =
Cell
'
Le
nombre
de
fois
que
la
donnée
apparait
dans
Plage_B.
Tableau
(
2
, i) =
k
'
-----------------------
End
If
Next
Cell
'
Copie
le
tableau
de
résultats
dans
la
Feuil2
Worksheets
(
"
Feuil2
"
).
Range
(
"
A1:B
"
&
i) =
Application.
Transpose
(
Tableau)
End
Sub
IV-F. Marquer ou supprimer les doublons▲
Option
Explicit
Sub
Test
(
)
IdentifieDoublons Range
(
"
A1:C20
"
)
End
Sub
Sub
IdentifieDoublons
(
Plage As
Range)
Dim
Cell As
Range
Dim
Un As
Collection
Set
Un =
New
Collection
On
Error
Resume
Next
'
Boucle
sur
la
plage
de
cellule
For
Each
Cell In
Plage
'
Pour
ne
pas
prendre
en
compte
les
cellules
vides
If
Cell <
>
"
"
Then
'
Ajoute
le
contenu
de
la
cellule
dans
la
collection
Un.
Add
Cell, CStr
(
Cell)
'
Si
la
procédure
renvoie
une
erreur,
cela
signifie
que
l'élément
'
existe
déjà
dans
la
collection
et
donc
qu'il
s'agit
d'un
doublon.
'
Dans
ce
cas
la
macro
colorie
la
cellule
en
vert.
If
Err
<
>
0
Then
Cell.
Interior
.
ColorIndex
=
4
'
Efface
toutes
les
valeurs
de
l'objet
Err.
Err
.
Clear
End
If
Next
Cell
Set
Un =
Nothing
End
Sub
La procédure ci-dessous (à partir d'Excel 2007) utilise la mise en forme conditionnelle pour mettre en surbrillance les données identiques:
'
Excel
2007
With
Range
(
"
A1:A10
"
)
.
FormatConditions
.
AddUniqueValues
.
FormatConditions
(
.
FormatConditions
.
Count
).
SetFirstPriority
'
Utilisez
xlUnique
pour
identifier
les
valeurs
uniques
.
FormatConditions
(
1
).
DupeUnique
=
xlDuplicate
.
FormatConditions
(
1
).
Interior
.
Color
=
RGB
(
255
, 0
, 0
)
End
With
Dans le chapitre II-C nous avons vu qu'il est possible d'utiliser les options du filtre élaboré afin de créer une liste sans doublons. L'exemple suivant montre comment réaliser la même opération par macro.
Sub
FiltreDoublons
(
)
Dim
Plage As
Range
'
Définit
la
plage
à
filtrer
(A1
correspond
à
l'entête
et
'
ne
sera
pas
pris
en
compte
dans
le
filtre)
Set
Plage =
Range
(
"
A1:C10
"
)
'
La
plage
filtrée
sans
doublons
va
s'afficher
'
dans
la
cellule
H1.
Plage.
AdvancedFilter
Action:=
xlFilterCopy, _
CopyToRange:=
Range
(
"
H1
"
), Unique:=
True
End
Sub
Lorsque vous souhaitez éliminer les doublons dans une colonne, une solution consiste à trier les données de cette colonne puis de supprimer les éléments identiques qui se suivent:
Option
Explicit
Sub
Test
(
)
'
Supprime
les
doublons
dans
la
colonne
B
SuppressionDoublonColonne 2
End
Sub
Sub
SuppressionDoublonColonne
(
NumCol As
Integer
)
Dim
Cible As
Range, Suivant As
Range
Application.
ScreenUpdating
=
False
With
Columns
(
NumCol)
.
Cells
(
1
, 1
).
Sort
Key1:=
.
Cells
(
1
, 1
), Order1:=
xlAscending
Set
Cible =
.
Cells
(
1
, 1
)
Do
Set
Suivant =
Cible.
Offset
(
1
, 0
)
If
Suivant =
Cible Then
Cible.
Delete
xlUp
Set
Cible =
Suivant
Loop
Until
Cible =
"
"
End
With
Application.
ScreenUpdating
=
True
End
Sub
Vous pouvez aussi supprimer les doublons sans trier les colonnes.
Voici un code qui boucle sur la plage A1:A10 et enregistre dans un tableau les numéros de lignes si les cellules contiennent des doublons.
La macro enregistre dans le tableau les numéros de lignes, mais vous pouvez bien entendu l'adapter à votre projet et le remplacer par la mise en mémoire des adresses de cellules, le contenu des cellules ... etc ...
La procédure utilise ensuite les éléments du tableau pour supprimer les lignes complètes dans la feuille de calcul.
Vous remarquerez que dans cet exemple les enregistrements sont supprimés à partir de la dernière ligne, en remontant vers la première ligne. Cette méthode simplifie la rédaction des macros sinon vous seriez obligés d'intégrer le décalage des lignes à chaque suppression.
Option
Explicit
Option
Base 1
Sub
SupprimeDoublons
(
)
Dim
Plage As
Range, Cell As
Range
Dim
Un As
Collection
Dim
Tableau
(
) As
Long
Dim
x As
Integer
Set
Un =
New
Collection
Set
Plage =
Worksheets
(
"
Feuil1
"
).
Range
(
"
A1:A10
"
)
For
Each
Cell In
Plage
On
Error
Resume
Next
'
Alimente
la
collection
de
données
sans
doublons.
Un.
Add
Cell, CStr
(
Cell)
'
Une
erreur
survient
si
l'élément
existe
dans
la
collection.
'
La
procédure
enregistre
le
numéro
de
ligne
correspondant
dans
un
tableau.
If
Err
.
Number
<
>
0
Then
x =
x +
1
ReDim
Preserve
Tableau
(
x)
Tableau
(
x) =
Cell.
Row
End
If
Next
Cell
'
On
sort
de
la
procédure
s'il
n'y
a
pas
de
doublons.
If
x =
0
Then
Exit
Sub
'
Permet
de
figer
l'écran
pendant
la
suppression
des
lignes.
Application.
ScreenUpdating
=
False
'
boucle
sur
le
tableau
pour
supprimer
les
lignes
contenant
les
doublons.
For
x =
UBound
(
Tableau) To
LBound
(
Tableau) Step
-
1
Worksheets
(
"
Feuil1
"
).
Rows
(
Tableau
(
x)).
EntireRow
.
Delete
Next
x
Application.
ScreenUpdating
=
True
MsgBox
"
Terminé.
"
Set
Un =
Nothing
End
Sub
Si vous disposez d'Excel 2007, utilisez directement la méthode RemoveDuplicates pour éliminer les valeurs en double dans une plage de cellules:
Sub
SuppressionDoublons_Excel2007
(
)
'
Header:=xlYes
'
permet
de
spécifier
que
la
1ere
ligne
correspond
à
un
entête
'
Columns:=Array(1,
3)
'
Définit
la
ou
les
colonnes
à
prendre
en
compte
pour
identifier
les
doublons
'
Supprime
les
données
dans
la
plage
A1:C10
si
les
enregistrements
des
colonnes
A
et
C
'
forment
un
doublon.
Worksheets
(
"
Feuil1
"
).
Range
(
"
A1:C10
"
).
RemoveDuplicates
_
Columns:=
Array
(
1
, 3
), Header:=
xlYes
End
Sub
IV-G. Alimenter un contrôle ComboBox sans doublon▲
Nota:
la propriété Style du ComboBox doit avoir la valeur 0 (fmStyleDropDownCombo) pour que la saisie de données soit autorisée dans la zone d'édition.
Private
Sub
UserForm_Initialize
(
)
Dim
i As
Integer
'
Boucle
sur
les
cellule
de
la
colonne
A
For
i =
1
To
Range
(
"
A65536
"
).
End
(
xlUp).
Row
'
Remplit
la
zone
d'édition
du
ComboBox
ComboBox1 =
Range
(
"
A
"
&
i)
'
ComboBox1.ListIndex
renvoie
-1
si
la
donnée
n'existe
pas
dans
'
la
liste
déroulante.
Dans
ce
cas,
on
va
pouvoir
utiliser
la
méthode
AddItem
'
pour
intégrer
la
donnée
dans
le
ComboBox.
'
(Range("A"
&
i)
<>
""
permet
simplement
de
gérer
les
éventuelles
cellules
vides
'
dans
la
colonne
A).
If
ComboBox1.
ListIndex
=
-
1
And
Range
(
"
A
"
&
i) <
>
"
"
Then
_
ComboBox1.
AddItem
Range
(
"
A
"
&
i)
Next
i
End
Sub
Téléchargez cet autre exemple qui permet d'alimenter une série de ComboBox en cascade et sans doublon.
La procédure alimente chaque Combobox en fonction de la sélection précédente. La sélection du ComboBox1 définit le contenu du ComboBox2. La sélection du ComboBox2 définit le contenu du ComboBox3 ...etc...
Le classeur démo.
IV-H. Générer une série de nombres entiers aléatoires sans doublon▲
La procédure suivante crée une série de nombres, de 1 à 25, de façon aléatoire et sans doublon.Les valeurs sont écrites verticalement dans la feuille de calcul, et une option permet d'indiquer à partir de quelle cellule vont être inscrites les données (B1 dans cet exemple).
Sub
Test
(
)
GenereSerieAleatoireSansDoublons 25
, Range
(
"
B1
"
)
End
Sub
Sub
GenereSerieAleatoireSansDoublons
(
NbValeurs As
Integer
, Cell As
Range)
Dim
Tableau
(
) As
Integer
, TabNumLignes
(
) As
Integer
Dim
i As
Integer
, k As
Integer
ReDim
Tableau
(
NbValeurs)
ReDim
TabNumLignes
(
NbValeurs)
For
i =
1
To
NbValeurs
TabNumLignes
(
i) =
i
Tableau
(
i) =
i
Next
'
Initialise
le
générateur
de
nombres
aléatoires
Randomize
For
i =
NbValeurs To
1
Step
-
1
k =
Int
(
(
i *
Rnd
) +
1
)
Cells
(
Cell.
Row
+
i -
1
, Cell.
Column
) =
Tableau
(
TabNumLignes
(
k))
TabNumLignes
(
k) =
TabNumLignes
(
i)
Next
End
Sub
Un autre exemple qui inscrit une série de 20 valeurs aléatoires, sans doublons et comprises entre 1 et 150.
Option
Explicit
Sub
Test
(
)
'
Inscrit
une
série
de
20
valeurs
aléatoires
dans
la
colonne,
à
partir
'
de
la
cellule
A1.
'
Les
valeurs
aléatoires
seront
comprises
entre
1
et
150.
SerieAleatoire Range
(
"
A1
"
), 150
, 20
End
Sub
Sub
SerieAleatoire
(
Cellule As
Range, ValMaxi As
Integer
, NbVal As
Integer
)
Dim
i As
Integer
Randomize
Cellule =
Int
(
ValMaxi *
Rnd
+
1
)
For
i =
1
To
NbVal -
1
Do
Cellule.
Offset
(
i, 0
) =
Int
(
ValMaxi *
Rnd
+
1
)
Loop
Until
Application.
IsNA
(
Application.
Match
_
(
Cellule.
Offset
(
i, 0
), Cellule.
Resize
(
i, 1
), 0
))
Next
i
End
Sub
Résuméabuiyad