Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Nom des colonnes comportant les mêmes valeurs aux mêmes adresses

5 réponses
Avatar
Bidou
Bonjour,

Dans un tableau comportant x colonnes de 20 lignes je voudrais à l'aide
d'une macro VBA obtenir le nom ( ou l'adresse) de la ou des colonnes qui
contiennent les mêmes valeurs aux mêmes endroits que la Colonne A
exemple

La colonne A contient la valeur "ok" en A2 ; A6 ; A7
Si la colonne E contient la même valeur en E2 ; E6 ; E7 je voudrais que la
macro retourne le résultat au moyen d'un msgbox "valeurs cherchées se
trouvent dans la colonne E"
Bien sûr d'autres colonnes peuvent remplir ces conditions
Merci de votre aide

5 réponses

Avatar
Hervé
Bonjour,

Pour la recherhe, la valeur est demandée par une InputBox. Adapte et teste :

Sub Recherche()
Dim Plage As Range
Dim Cel As Range
Dim Valeur
Dim Tbl()
Dim I As Integer
Dim Adr As String
Dim Res As String

'définie la plage à partir de B1
'(adapter le nom de la feuille)
With Worksheets("Feuil1")
Set Plage = .Range(.Cells(1, 2), _
.Cells( _
.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, _
.Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
'valeur cherchée
Valeur = InputBox("Veuillez indiquer la valeur " _
& "cherchée en colonne A !", _
"Recherche")
'recherche
Set Cel = Plage.Find(Valeur, , xlValues)

If Not Cel Is Nothing Then
Adr = Cel.Address
Do
I = I + 1
ReDim Preserve Tbl(1 To I)
'retourne la lettre de la colonne
'(seulement jusqu'à "Z")
'pour l'adresse de la cellule,
'remplacer par "Tbl(I) = Cel.Address(0, 0)"
Tbl(I) = Chr(64 + Cel.Column)
Set Cel = Plage.FindNext(Cel)
Loop While Cel.Address <> Adr
End If

On Error Resume Next
'concatène
For I = 1 To UBound(Tbl)
Res = Res & Tbl(I) & vbCrLf
Next
'retour
If Err.Number <> 0 Then
MsgBox "aucune valeur trouvée."
Else
MsgBox Res
End If

Erase Tbl
Set Plage = Nothing
Set Cel = Nothing
End Sub


Hervé.


"Bidou" a écrit dans le message de news:
491fc423$0$936$
Bonjour,

Dans un tableau comportant x colonnes de 20 lignes je voudrais à l'aide
d'une macro VBA obtenir le nom ( ou l'adresse) de la ou des colonnes qui
contiennent les mêmes valeurs aux mêmes endroits que la Colonne A
exemple

La colonne A contient la valeur "ok" en A2 ; A6 ; A7
Si la colonne E contient la même valeur en E2 ; E6 ; E7 je voudrais que la
macro retourne le résultat au moyen d'un msgbox "valeurs cherchées se
trouvent dans la colonne E"
Bien sûr d'autres colonnes peuvent remplir ces conditions
Merci de votre aide








Avatar
bidou
Merci Hervé
Un petit problème cependant : ta macro trouve la valeur cherchée mais ne
m'indique pas seulement les valeurs se trouvant aux mêmes adresses de
cellules exemple
la valeur "ok" se trouvant dans les cellules a2 a6 a7 doivent se trouver
dans les cellules (nom de colonne)ligne2 (nom de colonne)ligne6 (nom de
colonne)ligne7
merci quand même
"Hervé" a écrit dans le message de news:

Bonjour,

Pour la recherhe, la valeur est demandée par une InputBox. Adapte et teste
:

Sub Recherche()
Dim Plage As Range
Dim Cel As Range
Dim Valeur
Dim Tbl()
Dim I As Integer
Dim Adr As String
Dim Res As String

'définie la plage à partir de B1
'(adapter le nom de la feuille)
With Worksheets("Feuil1")
Set Plage = .Range(.Cells(1, 2), _
.Cells( _
.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, _
.Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
'valeur cherchée
Valeur = InputBox("Veuillez indiquer la valeur " _
& "cherchée en colonne A !", _
"Recherche")
'recherche
Set Cel = Plage.Find(Valeur, , xlValues)

If Not Cel Is Nothing Then
Adr = Cel.Address
Do
I = I + 1
ReDim Preserve Tbl(1 To I)
'retourne la lettre de la colonne
'(seulement jusqu'à "Z")
'pour l'adresse de la cellule,
'remplacer par "Tbl(I) = Cel.Address(0, 0)"
Tbl(I) = Chr(64 + Cel.Column)
Set Cel = Plage.FindNext(Cel)
Loop While Cel.Address <> Adr
End If

On Error Resume Next
'concatène
For I = 1 To UBound(Tbl)
Res = Res & Tbl(I) & vbCrLf
Next
'retour
If Err.Number <> 0 Then
MsgBox "aucune valeur trouvée."
Else
MsgBox Res
End If

Erase Tbl
Set Plage = Nothing
Set Cel = Nothing
End Sub


Hervé.


"Bidou" a écrit dans le message de news:
491fc423$0$936$
Bonjour,

Dans un tableau comportant x colonnes de 20 lignes je voudrais à l'aide
d'une macro VBA obtenir le nom ( ou l'adresse) de la ou des colonnes qui
contiennent les mêmes valeurs aux mêmes endroits que la Colonne A
exemple

La colonne A contient la valeur "ok" en A2 ; A6 ; A7
Si la colonne E contient la même valeur en E2 ; E6 ; E7 je voudrais que
la macro retourne le résultat au moyen d'un msgbox "valeurs cherchées se
trouvent dans la colonne E"
Bien sûr d'autres colonnes peuvent remplir ces conditions
Merci de votre aide












Avatar
Hervé
Bonsoir,

Peut être de cette façon ?

Sub Recherche()
Dim Plage1 As Range
Dim Plage2 As Range
Dim Cel1 As Range
Dim Cel2 As Range
Dim Valeur
Dim Tbl()
Dim I As Integer
Dim Adr1 As String
Dim Adr2 As String
Dim Res As String

'définie la plage sur la colonne A
With Worksheets("Feuil1")
Set Plage1 = .Range(.[A1], .[A65536].End(xlUp))
End With
'valeur cherchée
Valeur = InputBox("Veuillez indiquer la valeur " _
& "cherchée en colonne A !", _
"Recherche")
'recherche dans la colonne A
Set Cel1 = Plage1.Find(Valeur, _
Plage1.Cells(Plage1.Count), _
xlValues, _
xlWhole)

If Not Cel1 Is Nothing Then
Adr1 = Cel1.Address
Do
'défini la plage de recherche (plage en ligne)
Set Plage2 = Range(Cel1.Offset(0, 1), _
Cel1.Offset(0, 254).End(xlToLeft))
'recherche dans la ligne correspondante
Set Cel2 = Plage2.Find(Valeur, _
Plage2.Cells(, Plage2.Count - 1), _
xlValues, _
xlWhole)

If Not Cel2 Is Nothing Then
Adr2 = Cel2.Address
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = "Ligne " & Cel2.Row
Do
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = " Colonne " & Chr(64 + Cel2.Column)
Set Cel2 = Plage2.FindNext(Cel2)
Loop While Cel2.Address <> Adr2
End If

Set Cel1 = Plage1.FindNext(Cel1)
Loop While Cel1.Address <> Adr1
End If

On Error Resume Next

'concatène
For I = 1 To UBound(Tbl)
Res = Res & Tbl(I) & vbCrLf
Next
'retour
If Err.Number <> 0 Then
MsgBox "aucune valeur trouvée."
Else
MsgBox Res
End If

Erase Tbl
Set Plage1 = Nothing
Set Plage2 = Nothing
Set Cel1 = Nothing
Set Cel2 = Nothing
End Sub


Hervé.



"bidou" a écrit dans le message de news:
491ff2f8$0$915$
Merci Hervé
Un petit problème cependant : ta macro trouve la valeur cherchée mais ne
m'indique pas seulement les valeurs se trouvant aux mêmes adresses de
cellules exemple
la valeur "ok" se trouvant dans les cellules a2 a6 a7 doivent se trouver
dans les cellules (nom de colonne)ligne2 (nom de colonne)ligne6 (nom de
colonne)ligne7
merci quand même
"Hervé" a écrit dans le message de news:

Bonjour,

Pour la recherhe, la valeur est demandée par une InputBox. Adapte et
teste :

Sub Recherche()
Dim Plage As Range
Dim Cel As Range
Dim Valeur
Dim Tbl()
Dim I As Integer
Dim Adr As String
Dim Res As String

'définie la plage à partir de B1
'(adapter le nom de la feuille)
With Worksheets("Feuil1")
Set Plage = .Range(.Cells(1, 2), _
.Cells( _
.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, _
.Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
'valeur cherchée
Valeur = InputBox("Veuillez indiquer la valeur " _
& "cherchée en colonne A !", _
"Recherche")
'recherche
Set Cel = Plage.Find(Valeur, , xlValues)

If Not Cel Is Nothing Then
Adr = Cel.Address
Do
I = I + 1
ReDim Preserve Tbl(1 To I)
'retourne la lettre de la colonne
'(seulement jusqu'à "Z")
'pour l'adresse de la cellule,
'remplacer par "Tbl(I) = Cel.Address(0, 0)"
Tbl(I) = Chr(64 + Cel.Column)
Set Cel = Plage.FindNext(Cel)
Loop While Cel.Address <> Adr
End If

On Error Resume Next
'concatène
For I = 1 To UBound(Tbl)
Res = Res & Tbl(I) & vbCrLf
Next
'retour
If Err.Number <> 0 Then
MsgBox "aucune valeur trouvée."
Else
MsgBox Res
End If

Erase Tbl
Set Plage = Nothing
Set Cel = Nothing
End Sub


Hervé.


"Bidou" a écrit dans le message de news:
491fc423$0$936$
Bonjour,

Dans un tableau comportant x colonnes de 20 lignes je voudrais à l'aide
d'une macro VBA obtenir le nom ( ou l'adresse) de la ou des colonnes qui
contiennent les mêmes valeurs aux mêmes endroits que la Colonne A
exemple

La colonne A contient la valeur "ok" en A2 ; A6 ; A7
Si la colonne E contient la même valeur en E2 ; E6 ; E7 je voudrais que
la macro retourne le résultat au moyen d'un msgbox "valeurs cherchées se
trouvent dans la colonne E"
Bien sûr d'autres colonnes peuvent remplir ces conditions
Merci de votre aide
















Avatar
bidou
Bonjour et merci Hervé çà fonctionne !


"Hervé" a écrit dans le message de news:

Bonsoir,

Peut être de cette façon ?

Sub Recherche()
Dim Plage1 As Range
Dim Plage2 As Range
Dim Cel1 As Range
Dim Cel2 As Range
Dim Valeur
Dim Tbl()
Dim I As Integer
Dim Adr1 As String
Dim Adr2 As String
Dim Res As String

'définie la plage sur la colonne A
With Worksheets("Feuil1")
Set Plage1 = .Range(.[A1], .[A65536].End(xlUp))
End With
'valeur cherchée
Valeur = InputBox("Veuillez indiquer la valeur " _
& "cherchée en colonne A !", _
"Recherche")
'recherche dans la colonne A
Set Cel1 = Plage1.Find(Valeur, _
Plage1.Cells(Plage1.Count), _
xlValues, _
xlWhole)

If Not Cel1 Is Nothing Then
Adr1 = Cel1.Address
Do
'défini la plage de recherche (plage en ligne)
Set Plage2 = Range(Cel1.Offset(0, 1), _
Cel1.Offset(0, 254).End(xlToLeft))
'recherche dans la ligne correspondante
Set Cel2 = Plage2.Find(Valeur, _
Plage2.Cells(, Plage2.Count - 1), _
xlValues, _
xlWhole)

If Not Cel2 Is Nothing Then
Adr2 = Cel2.Address
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = "Ligne " & Cel2.Row
Do
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = " Colonne " & Chr(64 + Cel2.Column)
Set Cel2 = Plage2.FindNext(Cel2)
Loop While Cel2.Address <> Adr2
End If

Set Cel1 = Plage1.FindNext(Cel1)
Loop While Cel1.Address <> Adr1
End If

On Error Resume Next

'concatène
For I = 1 To UBound(Tbl)
Res = Res & Tbl(I) & vbCrLf
Next
'retour
If Err.Number <> 0 Then
MsgBox "aucune valeur trouvée."
Else
MsgBox Res
End If

Erase Tbl
Set Plage1 = Nothing
Set Plage2 = Nothing
Set Cel1 = Nothing
Set Cel2 = Nothing
End Sub


Hervé.



"bidou" a écrit dans le message de news:
491ff2f8$0$915$
Merci Hervé
Un petit problème cependant : ta macro trouve la valeur cherchée mais ne
m'indique pas seulement les valeurs se trouvant aux mêmes adresses de
cellules exemple
la valeur "ok" se trouvant dans les cellules a2 a6 a7 doivent se trouver
dans les cellules (nom de colonne)ligne2 (nom de colonne)ligne6 (nom de
colonne)ligne7
merci quand même
"Hervé" a écrit dans le message de news:

Bonjour,

Pour la recherhe, la valeur est demandée par une InputBox. Adapte et
teste :

Sub Recherche()
Dim Plage As Range
Dim Cel As Range
Dim Valeur
Dim Tbl()
Dim I As Integer
Dim Adr As String
Dim Res As String

'définie la plage à partir de B1
'(adapter le nom de la feuille)
With Worksheets("Feuil1")
Set Plage = .Range(.Cells(1, 2), _
.Cells( _
.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, _
.Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
'valeur cherchée
Valeur = InputBox("Veuillez indiquer la valeur " _
& "cherchée en colonne A !", _
"Recherche")
'recherche
Set Cel = Plage.Find(Valeur, , xlValues)

If Not Cel Is Nothing Then
Adr = Cel.Address
Do
I = I + 1
ReDim Preserve Tbl(1 To I)
'retourne la lettre de la colonne
'(seulement jusqu'à "Z")
'pour l'adresse de la cellule,
'remplacer par "Tbl(I) = Cel.Address(0, 0)"
Tbl(I) = Chr(64 + Cel.Column)
Set Cel = Plage.FindNext(Cel)
Loop While Cel.Address <> Adr
End If

On Error Resume Next
'concatène
For I = 1 To UBound(Tbl)
Res = Res & Tbl(I) & vbCrLf
Next
'retour
If Err.Number <> 0 Then
MsgBox "aucune valeur trouvée."
Else
MsgBox Res
End If

Erase Tbl
Set Plage = Nothing
Set Cel = Nothing
End Sub


Hervé.


"Bidou" a écrit dans le message de news:
491fc423$0$936$
Bonjour,

Dans un tableau comportant x colonnes de 20 lignes je voudrais à l'aide
d'une macro VBA obtenir le nom ( ou l'adresse) de la ou des colonnes
qui contiennent les mêmes valeurs aux mêmes endroits que la Colonne A
exemple

La colonne A contient la valeur "ok" en A2 ; A6 ; A7
Si la colonne E contient la même valeur en E2 ; E6 ; E7 je voudrais que
la macro retourne le résultat au moyen d'un msgbox "valeurs cherchées
se trouvent dans la colonne E"
Bien sûr d'autres colonnes peuvent remplir ces conditions
Merci de votre aide




















Avatar
Hervé
Bonsoir Bidou,

Merci du retour et heureux que cela te convienne.

Hervé.


"bidou" a écrit dans le message de news:
49210a13$0$881$
Bonjour et merci Hervé çà fonctionne !


"Hervé" a écrit dans le message de news:

Bonsoir,

Peut être de cette façon ?

Sub Recherche()
Dim Plage1 As Range
Dim Plage2 As Range
Dim Cel1 As Range
Dim Cel2 As Range
Dim Valeur
Dim Tbl()
Dim I As Integer
Dim Adr1 As String
Dim Adr2 As String
Dim Res As String

'définie la plage sur la colonne A
With Worksheets("Feuil1")
Set Plage1 = .Range(.[A1], .[A65536].End(xlUp))
End With
'valeur cherchée
Valeur = InputBox("Veuillez indiquer la valeur " _
& "cherchée en colonne A !", _
"Recherche")
'recherche dans la colonne A
Set Cel1 = Plage1.Find(Valeur, _
Plage1.Cells(Plage1.Count), _
xlValues, _
xlWhole)

If Not Cel1 Is Nothing Then
Adr1 = Cel1.Address
Do
'défini la plage de recherche (plage en ligne)
Set Plage2 = Range(Cel1.Offset(0, 1), _
Cel1.Offset(0, 254).End(xlToLeft))
'recherche dans la ligne correspondante
Set Cel2 = Plage2.Find(Valeur, _
Plage2.Cells(, Plage2.Count - 1), _
xlValues, _
xlWhole)

If Not Cel2 Is Nothing Then
Adr2 = Cel2.Address
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = "Ligne " & Cel2.Row
Do
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = " Colonne " & Chr(64 + Cel2.Column)
Set Cel2 = Plage2.FindNext(Cel2)
Loop While Cel2.Address <> Adr2
End If

Set Cel1 = Plage1.FindNext(Cel1)
Loop While Cel1.Address <> Adr1
End If

On Error Resume Next

'concatène
For I = 1 To UBound(Tbl)
Res = Res & Tbl(I) & vbCrLf
Next
'retour
If Err.Number <> 0 Then
MsgBox "aucune valeur trouvée."
Else
MsgBox Res
End If

Erase Tbl
Set Plage1 = Nothing
Set Plage2 = Nothing
Set Cel1 = Nothing
Set Cel2 = Nothing
End Sub


Hervé.



"bidou" a écrit dans le message de news:
491ff2f8$0$915$
Merci Hervé
Un petit problème cependant : ta macro trouve la valeur cherchée mais ne
m'indique pas seulement les valeurs se trouvant aux mêmes adresses de
cellules exemple
la valeur "ok" se trouvant dans les cellules a2 a6 a7 doivent se trouver
dans les cellules (nom de colonne)ligne2 (nom de colonne)ligne6 (nom de
colonne)ligne7
merci quand même
"Hervé" a écrit dans le message de news:

Bonjour,

Pour la recherhe, la valeur est demandée par une InputBox. Adapte et
teste :

Sub Recherche()
Dim Plage As Range
Dim Cel As Range
Dim Valeur
Dim Tbl()
Dim I As Integer
Dim Adr As String
Dim Res As String

'définie la plage à partir de B1
'(adapter le nom de la feuille)
With Worksheets("Feuil1")
Set Plage = .Range(.Cells(1, 2), _
.Cells( _
.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, _
.Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
'valeur cherchée
Valeur = InputBox("Veuillez indiquer la valeur " _
& "cherchée en colonne A !", _
"Recherche")
'recherche
Set Cel = Plage.Find(Valeur, , xlValues)

If Not Cel Is Nothing Then
Adr = Cel.Address
Do
I = I + 1
ReDim Preserve Tbl(1 To I)
'retourne la lettre de la colonne
'(seulement jusqu'à "Z")
'pour l'adresse de la cellule,
'remplacer par "Tbl(I) = Cel.Address(0, 0)"
Tbl(I) = Chr(64 + Cel.Column)
Set Cel = Plage.FindNext(Cel)
Loop While Cel.Address <> Adr
End If

On Error Resume Next
'concatène
For I = 1 To UBound(Tbl)
Res = Res & Tbl(I) & vbCrLf
Next
'retour
If Err.Number <> 0 Then
MsgBox "aucune valeur trouvée."
Else
MsgBox Res
End If

Erase Tbl
Set Plage = Nothing
Set Cel = Nothing
End Sub


Hervé.


"Bidou" a écrit dans le message de news:
491fc423$0$936$
Bonjour,

Dans un tableau comportant x colonnes de 20 lignes je voudrais à
l'aide d'une macro VBA obtenir le nom ( ou l'adresse) de la ou des
colonnes qui contiennent les mêmes valeurs aux mêmes endroits que la
Colonne A
exemple

La colonne A contient la valeur "ok" en A2 ; A6 ; A7
Si la colonne E contient la même valeur en E2 ; E6 ; E7 je voudrais
que la macro retourne le résultat au moyen d'un msgbox "valeurs
cherchées se trouvent dans la colonne E"
Bien sûr d'autres colonnes peuvent remplir ces conditions
Merci de votre aide