Détecter une cellule
Résolu
nonossov
Messages postés
610
Date d'inscription
Statut
Membre
Dernière intervention
-
nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention -
nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention -
Bonjour mes amis;
Grâce à votre aide mes chers amis, je recherche une macro qui peut détecter le numéro de cellule dans un fichier excel, par deux critères, le premier dans une colonne et le deuxième dans une ligne, par exemple:
feuil 1:
colonne B j'ai: B5: Paris
Colonne A j'ai: A5: France
je dois chercher ces deux critères dans le fichier excel et aller à cette cellule.
Grâce à votre aide mes chers amis, je recherche une macro qui peut détecter le numéro de cellule dans un fichier excel, par deux critères, le premier dans une colonne et le deuxième dans une ligne, par exemple:
feuil 1:
colonne B j'ai: B5: Paris
Colonne A j'ai: A5: France
je dois chercher ces deux critères dans le fichier excel et aller à cette cellule.
A voir également:
- Détecter une cellule
- Comment détecter un traceur sur téléphone - Accueil - Confidentialité
- Excel cellule couleur si condition texte - Guide
- Aller à la ligne dans une cellule excel - Guide
- Proteger cellule excel - Guide
- Détecter clé usb - Guide
3 réponses
yg_be
Messages postés
23541
Date d'inscription
Statut
Contributeur
Dernière intervention
Ambassadeur
1 584
bonsoir, peux-tu décrire ton exemple jusqu'au bout?
yg_be
Messages postés
23541
Date d'inscription
Statut
Contributeur
Dernière intervention
Ambassadeur
1 584
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
yg_be
Messages postés
23541
Date d'inscription
Statut
Contributeur
Dernière intervention
Ambassadeur
1 584
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
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