Détecter une cellule Résolu

Question

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.
Configuration: Windows / Firefox 47.0

yg_be · Accepted Answer

bonsoir, peux-tu décrire ton exemple jusqu'au bout?

yg_be · Answer

je propose ceci:

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

yg_be · Answer

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

Détecter une cellule

3 réponses

Discussions similaires

Newsletters