Détecter une cellule
Résolu/Fermé
nonossov
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020
-
24 mars 2017 à 15:38
nonossov Messages postés 611 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020 - 5 avril 2017 à 11:17
nonossov Messages postés 611 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020 - 5 avril 2017 à 11:17
A voir également:
- Détecter une cellule
- Excel colorer une cellule sous condition d'une autre cellule ✓ - Forum Excel
- Aller à la ligne dans une cellule excel - Guide
- Verrouiller cellule excel - Guide
- Le fichier contient le nombre de voyageurs dans 3 gares. dans la cellule b5, saisissez une formule qui calcule le total et se met à jour si on change une valeur du tableau. quel total obtenez-vous ? quelle formule avez-vous saisie ? ✓ - Forum Excel
- Excel si cellule contient texte alors ✓ - Forum Excel
3 réponses
yg_be
Messages postés
21304
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 mars 2023
1 325
25 mars 2017 à 19:43
25 mars 2017 à 19:43
bonsoir, peux-tu décrire ton exemple jusqu'au bout?
yg_be
Messages postés
21304
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 mars 2023
1 325
31 mars 2017 à 17:06
31 mars 2017 à 17:06
avec quelques commentaires:
Option Explicit
Sub nonossov_color()
Dim critere As Range, matrice As Range
Set critere = [Feuil1!A2] ' position de la première cellule où se trouvent les critères
Set matrice = [Feuil2!A1] ' position de la cellule en haut à gauche de la table à colorier
Dim ncol As Long, icol As Long
Dim nlig As Long, fcol As Long
Dim ws As Worksheet
Dim col As Scripting.Dictionary
Set col = New Scripting.Dictionary
Dim lig As Scripting.Dictionary
Set lig = New Scripting.Dictionary
Dim horval() As Long
Dim numcol As Long
Dim verval As Long
' parcourons et mémorisons les critères de recherche
ncol = critere.Column
nlig = critere.Row
Set ws = critere.Worksheet
Do While ws.Cells(nlig, ncol) <> ""
col.Add ws.Cells(nlig, ncol).Value, nlig
lig.Add ws.Cells(nlig, ncol + 1).Value, nlig
nlig = nlig + 1
Loop
' parcourons les titres de colonnes, et mémorisons leur positions dans les critères de recherche
ncol = matrice.Column
nlig = matrice.Row
numcol = 0
Set ws = matrice.Worksheet
Do While ws.Cells(nlig, ncol + 1) <> ""
ncol = ncol + 1
numcol = numcol + 1
ReDim Preserve horval(1 To numcol)
If lig.Exists(ws.Cells(nlig, ncol).Value) Then
horval(numcol) = lig(ws.Cells(nlig, ncol).Value)
Else
horval(numcol) = 0
End If
Loop
' parcourons la table à colorier
nlig = matrice.Row + 1
fcol = matrice.Column
' parcourons chaque ligne
Do While ws.Cells(nlig, fcol) <> ""
If col.Exists(ws.Cells(nlig, fcol).Value) Then
' le titre de ligne est à rechercher
verval = col(ws.Cells(nlig, fcol).Value)
' parcourons chaque colonne de cette ligne
For icol = 1 To numcol
If verval = horval(icol) Then
' le titre de colonne et le titre de ligne forment un critère de recherche
' colorions la cellule
ws.Cells(nlig, fcol + icol).Interior.ColorIndex = 37
End If
Next icol
End If
nlig = nlig + 1
Loop
End Sub
nonossov
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020
1
5 avril 2017 à 11:17
5 avril 2017 à 11:17
Merci infiniment,
yg_be
Messages postés
21304
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 mars 2023
1 325
30 mars 2017 à 00:19
30 mars 2017 à 00:19
je propose ceci:
tiens-moi au courant
Option Explicit
Sub nonossov_color()
Dim critere As Range, matrice As Range
Set critere = [Feuil1!A3]
Set matrice = [Feuil2!A1]
Dim ncol As Long, icol As Long
Dim nlig As Long, fcol As Long
Dim ws As Worksheet
Dim col As Scripting.Dictionary
Set col = New Scripting.Dictionary
Dim lig As Scripting.Dictionary
Set lig = New Scripting.Dictionary
Dim horval() As Long
Dim numcol As Long
Dim verval As Long
ncol = critere.Column
nlig = critere.Row
Set ws = critere.Worksheet
Do While ws.Cells(nlig, ncol) <> ""
col.Add ws.Cells(nlig, ncol).Value, nlig
lig.Add ws.Cells(nlig, ncol + 1).Value, nlig
nlig = nlig + 1
Loop
ncol = matrice.Column
nlig = matrice.Row
numcol = 0
Set ws = matrice.Worksheet
Do While ws.Cells(nlig, ncol + 1) <> ""
ncol = ncol + 1
numcol = numcol + 1
ReDim Preserve horval(1 To numcol)
If lig.Exists(ws.Cells(nlig, ncol).Value) Then
horval(numcol) = lig(ws.Cells(nlig, ncol).Value)
Else
horval(numcol) = 0
End If
Loop
nlig = matrice.Row + 1
fcol = matrice.Column
Do While ws.Cells(nlig, fcol) <> ""
If col.Exists(ws.Cells(nlig, fcol).Value) Then
verval = col(ws.Cells(nlig, fcol).Value)
For icol = 1 To numcol
If verval = horval(icol) Then
ws.Cells(nlig, fcol + icol).Interior.ColorIndex = 37
End If
Next icol
nlig = nlig + 1
End If
Loop
End Sub
tiens-moi au courant
nonossov
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020
1
30 mars 2017 à 10:26
30 mars 2017 à 10:26
Merci infiniment, mais je recois ce msg: Erreur de compilation:
Type défini par l'utilisateur non défini
col As Scripting.Dictionary
Sub nonossov_color() "coloré en jaune."
Type défini par l'utilisateur non défini
col As Scripting.Dictionary
Sub nonossov_color() "coloré en jaune."
yg_be
Messages postés
21304
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 mars 2023
1 325
>
nonossov
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020
30 mars 2017 à 11:15
30 mars 2017 à 11:15
ah oui, j'ai oublié de te prévenir : tu dois ajouter "microsoft scripting runtime" dans les références (menu outils/references).
nonossov
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020
1
30 mars 2017 à 11:37
30 mars 2017 à 11:37
Meric, j'ai une question: Comment je peux l'exécuter? je dois choisir les cellules ou comment?
nonossov
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020
1
30 mars 2017 à 12:04
30 mars 2017 à 12:04
j'ai exécuté la macro est le fichier excel est bloqué? comment puis-je l'exécuté?
yg_be
Messages postés
21304
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 mars 2023
1 325
>
nonossov
Messages postés
611
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
17 janvier 2020
30 mars 2017 à 17:22
30 mars 2017 à 17:22
pour tester, tu peux changer les lignes suivantes:
Elles contrôlent la première cellule contenant un critère, et la cellule en haut à gauche de la zone à examiner.
Set critere = [Feuil1!A3] Set matrice = [Feuil2!A1]
Elles contrôlent la première cellule contenant un critère, et la cellule en haut à gauche de la zone à examiner.
27 mars 2017 à 16:11
dans le feuil 1: j'ai ces données:
Colonne A/B
Paris Rue 1
Lyon Rue 2
London Rue 3
Tanger Rue 4
Berlin Rue 5
cette macro doit détecter la cellule qui correspond à chacun aux deux données, comme il est coloré dans le feuil 2:
https://www.cjoint.com/c/GCBolw3IELV
Merci
27 mars 2017 à 20:49
28 mars 2017 à 11:14
28 mars 2017 à 11:29
28 mars 2017 à 12:26