XL 2016 Récupérer nom colonne à partir de cellules

M

maroon

XLDnaute Junior
Bonjour!

Je n'arrive pas à récupérer le nom des colonnes qui correspondent aux cellules récupérées par la macro.
Ca ne me semble pas très compliqué mais j'ai essayé plein de choses sans succès...
Je mets un fichier exemple avec les explications à l'intérieur.... si quelqu'un peu me dire comment faire merci beaucoup!!!
 

Pièces jointes

  • TAB_EX_2.xlsm
    36.4 KB · Affichages: 12
Solution
Staple1600
Re

Allez confinement oblige, c'est KADO
(plus de resize)
VB: 
Sub Test_D()
Dim Ligne&, Rng As Range, col_MaX$, col_MiN$
Dim f As Worksheet: Set f = Sheets("RECAP")
With Application
    Ligne = .Match(Sheets("GRAPH").[B1], f.[A:A], 0)
    Set Rng = Sheets("RECAP").Rows(Ligne)
    col_MaX = f.Cells(1, .Match(.Max(Rng), Rng, 0) + 2)
    col_MiN = f.Cells(1, .Match(.Min(Rng), Rng, 0) + 2)
End With
MsgBox "Max: " & col_MaX & Chr(13) & "Min: " & col_MiN, vbInformation, "Résultats"
End Sub
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

Une façon de faire
VB: 
Sub Test()
Dim Ligne&, Rng As Range
Ligne = Application.Match(Sheets("GRAPH").[B1], Sheets("RECAP").[A:A], 0)
Set Rng = Sheets("RECAP").Cells(Ligne, 1).Offset(, 2).Resize(, 5)
vMAX = Application.Max(Rng)
vMIN = Application.Min(Rng)
MsgBox "Max: " & vMAX & Chr(13) & "Min: " & vMIN
End Sub
Je te laisse adapter pour que vMAX et vMIX atterrissent dans des cellules plutôt que dans un MsgBox ;)
 
Vote positif 0 Vote négatif
M

maroon

XLDnaute Junior
Staple1600 à dit:
Bonsoir le fil

Une façon de faire
VB: 
Sub Test()
Dim Ligne&, Rng As Range
Ligne = Application.Match(Sheets("GRAPH").[B1], Sheets("RECAP").[A:A], 0)
Set Rng = Sheets("RECAP").Cells(Ligne, 1).Offset(, 2).Resize(, 5)
vMAX = Application.Max(Rng)
vMIN = Application.Min(Rng)
MsgBox "Max: " & vMAX & Chr(13) & "Min: " & vMIN
End Sub
Je te laisse adapter pour que vMAX et vMIX atterrissent dans des cellules plutôt que dans un MsgBox ;)
Cliquez pour agrandir...
Bonjour Staple1600! :D
Merci pour ta réponse!!
Le code que tu m'as envoyé fonctionne bien sauf qu'en fait j'ai déjà réussi à récupérer les adresses des cellules qui contiennent les valeurs valeurs max et min (de plus il peut y avoir plusieurs valeurs min ou max égales donc j'ai fait une boucle avec la fonction findnext() et l'ensemble des cellules min par exemple sont stockées dans la variable "plage") sauf que ce dont j'ai besoin c'est de récupérer le nom des colonnes correspondantes (ou du moins les cellules cells (1, i) ) puis de recopier leur nom séparés pas un "-" dans les cellule C4 (pour les mins) et C5 (pour les maxs).

Dans le fichier exemple que j'ai mis ce sont les adresses des cellules contenant les valeurs "min" qui sont récupérées et affichées dans la Msgbox.
 
Vote positif 0 Vote négatif
M

maroon

XLDnaute Junior
Le code que j'ai fait est le suivant (pour les "mins" et j'ai le même pour les max):
VB: 
Sub valcol_min()
Dim r As Range
Dim s As Range
Dim Derlig As Integer
Dim i As Integer
Dim Line As Range

Dim cellule1 As String
Dim cellule As Range
Dim plage As Range
 

Derlig = Worksheets("RECAP").Columns("A:A").Find("*", Range("A1"), , , xlByRows, xlPrevious).Row

Lig = 0
Set r = Sheets("GRAPH").Range("B1")
Set s = Sheets("GRAPH").Range("B4")

With Worksheets("RECAP")

For i = 2 To Derlig
    If .Range("A" & i).Value = r.Value Then
        Set Line = .Rows(i).Find(What:=s, lookat:=xlWhole)
            If Not Line Is Nothing Then
                        
                Num = Line.Column
        Set plage = Line
            Do
                Set Line = .Rows(i).FindNext(Line)
                Set plage = Application.Union(plage, Line)
            Loop Until Line.Column = Num
            End If
        End If
    Next
End With
          
MsgBox plage.Address

End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Si, si. Il fait cela aussi.
Il suffit d'adapter un chouia ;)
(toujours sans boucle, et un choui plus court ;))
VB: 
Sub Test_C()
Dim Ligne&, Rng As Range, col_MaX$, col_MiN$
Dim f As Worksheet: Set f = Sheets("RECAP")
With Application
    Ligne = .Match(Sheets("GRAPH").[B1], f.[A:A], 0)
    Set Rng = Sheets("RECAP").Cells(Ligne, 1).Offset(, 2).Resize(, 5)
    col_MaX = f.Cells(1, .Match(.Max(Rng), Rng, 0) + 2)
    col_MiN = f.Cells(1, .Match(.Min(Rng), Rng, 0) + 2)
End With
MsgBox "Max: " & col_MaX & Chr(13) & "Min: " & col_MiN, vbInformation, "Résultats"
End Sub
NB: Je propose un code avec les éléments décrits dans le message#1
Si la change donne encore de route, bah charge au demandeur de faire les adaptations idoines ;)
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Allez confinement oblige, c'est KADO
(plus de resize)
VB: 
Sub Test_D()
Dim Ligne&, Rng As Range, col_MaX$, col_MiN$
Dim f As Worksheet: Set f = Sheets("RECAP")
With Application
    Ligne = .Match(Sheets("GRAPH").[B1], f.[A:A], 0)
    Set Rng = Sheets("RECAP").Rows(Ligne)
    col_MaX = f.Cells(1, .Match(.Max(Rng), Rng, 0) + 2)
    col_MiN = f.Cells(1, .Match(.Min(Rng), Rng, 0) + 2)
End With
MsgBox "Max: " & col_MaX & Chr(13) & "Min: " & col_MiN, vbInformation, "Résultats"
End Sub
 
Vote positif 0 Vote négatif
Solution
M

maroon

XLDnaute Junior
Rebonjour Staple1600!

Super merci pour le code! J'essaye de comprendre comment l'utiliser pour trouver toutes les cellules et non pas uniquement la première (car il peut y avoir plusieurs max ou plusieurs min).

les deux "+2" à la fin des lignes col_MaX et col_MiN me faussaient les résultats je crois, mais je ne sais pas à quoi ils servent. J'ai l'impression qu'ils ajoutent 2 unités aux numéros :oops:

Pour le moment j'ai utilisé ta solution et je l'ai insérée dans mon code et ça marche!! Mais j'essaye d'utiliser le tiens car beaucoup plus cours et la technique m'intéresse...

Merci encore pour ton aide!!

VB: 
Sub valcol_min()
Dim r As Range
Dim s As Range
Dim Derlig As Integer
Dim i As Integer
Dim Line As Range
Dim res As String
Dim cel As Variant
Dim cellule1 As String
Dim cellule As Range
Dim plage As Range


Derlig = Worksheets("RECAP").Columns("A:A").Find("*", Range("A1"), , , xlByRows, xlPrevious).Row

Lig = 0
Set r = Sheets("GRAPH").Range("B1")
Set s = Sheets("GRAPH").Range("B4")

With Worksheets("RECAP")

For i = 2 To Derlig
    If .Range("A" & i).Value = r.Value Then
        Set Line = .Rows(i).Find(What:=s, lookat:=xlWhole)
            If Not Line Is Nothing Then
                       
                Num = Line.Column
        Set plage = Line
            Do
                Set Line = .Rows(i).FindNext(Line)
                Set plage = Application.Union(plage, Line)
            Loop Until Line.Column = Num
            End If
        End If
    Next
End With
res = ""
For Each cel In plage

res = res & Worksheets("RECAP").Cells(1, cel.Column) & Chr(10)

Next

Range("c4") = Left(res, Len(res) - 1)
End Sub
 
Vote positif 0 Vote négatif
M

maroon

XLDnaute Junior
Bonjour Staple1600!

Mais Jacques a du se tromper parce que je ne vois rien dans le code du message#10 qui ressemble à ma prose vbaistique ;)
Cliquez pour agrandir...
oui! :D c'est comment tu as utilisé les résultats de la fonction match() dans l'adresse des cellules pour les lignes col_MaX et col_MiN, j'ai fait pareil mais avec les résultats contenus dans ma variable "plage"... c'est tout bête mais débutant en VBA + fatigue ça donne çao_O

Par contre si c'est possible j'aimerais beaucoup avoir des explications sur les lignes col_MaX et MiN... je comprends l'imbrication de max() dans match() mais je n'ai pas bien compris le sens du 3ème argument de match() (qui vaut 0 dans ton code) dans l'aide d'excel; ni les "+2" (qui avaient l'air de fausser mes résultats, et ensuite je n'arrive pas à stocker tous les résultats possibles dans une variable (en faisant une boucle comme dans mon code)... mais je vais essayer encore...

PS: dans mon code le "Lig=0" ne sert à rien...
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

A TESTER SUR UNE VIERGE (une feuille s'entend!)
VB: 
Sub Je_Ne_Suis_Qu_1_Macro(Optional De_Test_UNIQUEMENT_de_Test) 'Peut pas mieux dire ;-)
Dim vTest: Application.ScreenUpdating = False
Dim P As Range, P2 As Range: Set P = Range("A1:E15"): P = "=(ROW()*COLUMN())*100"
MsgBox "Max: " & Application.Max(P): MsgBox "Min: " & Application.Min(P)
Set P2 = Range("B2:B6")
MsgBox "Max: " & Application.Max(P2), , P2.Address(0, 0): MsgBox "Min: " & Application.Min(P2), , P2.Address(0, 0)
vTest = InputBox("Nombre cherché?", "Choix valeur", 1600)
Ligne = Application.Match(CLng(vTest), [B1:B15], 0)
MsgBox vTest & " trouvé!" & Chr(13) & "Ligne N°: " & Ligne & " | Adresse: " & Cells(Ligne, "B").Address(0, 0) _
, , "Colonne B"
[C1:C15] = [C1:C15].Value
Application.ScreenUpdating = True
[C1:C15].Sort Key1:=[C1], Order1:=xlAscending, Header:=xlNo
Ligne = Application.Match(CLng(vTest), [C1:C15], 1)
With Cells(Ligne, "C")
MsgBox .Address(0, 0) & "->" & .Value2, , [C1:C15].Address(0, 0)
End With
[C1:C15].Sort Key1:=[C1], Order1:=xlDescending, Header:=xlNo
Ligne = Application.Match(CLng(vTest), [C1:C15], -1)
With Cells(Ligne, "C")
MsgBox .Address(0, 0) & "->" & .Value2, , [C1:C15].Address(0, 0)
End With
End Sub
PS: ne pas oublier pour comprendre les 0, -1 ou 1 d'aller voir l'aide sur la fonction EQUIV dans Excel.

Bon test et bonne lecture ;)
 
Vote positif 0 Vote négatif
M

maroon

XLDnaute Junior
Rebonjour Staple1600!:D

Je crois que sur ce coup j'ai eu du mal à me faire comprendre... En tous cas merci pour ce code #13 que je vais essayer de comprendre (et avant ça de comprendre ce qu'il fait:oops:).

Dans tous les cas ton message #9 m'a permis de faire ce que je voulais (comme je l'ai expliqué au #12).

Dès que j'ai fini mon travail j'essaye de comprendre ce code #13 car je pense qu'il me permettra d'apprendre un certain nombre de choses!

Merci encore pour ton aide et ton implication!!:cool:

PS: ok je vais regarder l'aide sur EQUIV() (j'avais regardé celle sur MATCH() que je n'ai pas trouvée très explicite sur l'argument en question "arg3")
 
Vote positif 0 Vote négatif

Discussions similaires

Fred S.
  • Question
XL 2016 Recherche multicritères
Réponses
9
Affichages
410
djidji59430
djidji59430
edgy63
  • Question
Microsoft 365 Remplir cellules à partir de plusieurs fichiers Excel d'un dossier
2
Réponses
17
Affichages
500
alexga78
A
O
  • Résolu(e)
Microsoft 365 Effacer le contenu de cellules si une autre cellule est vide
Réponses
9
Affichages
222
Olihoes
O
S
  • Question
XL 2021 Nommer un objet Edge pour pouvoir récupérer des infos
Réponses
0
Affichages
200
SgTrGt
S
Z
  • Résolu(e)
Microsoft 365 (résolu) Position d'une valeur max dans un tableau avec ex-aequo
2
Réponses
15
Affichages
534
crocrocro
C
Y
  • Résolu(e)
XL 2013 Récupérer le contenu d'un Tableau dans un autre classeur via Power Query et non toute la feuille...
Réponses
4
Affichages
415
Yvan1
Y
E
  • Résolu(e)
Microsoft 365 Trouver Date début et date de fin
2
Réponses
15
Affichages
802
eric72
E
P
  • Résolu(e)
Microsoft 365 Exporte format d'impression à d'autres onglet
Réponses
3
Affichages
314
PatrickNyon
P
N
  • Question
Microsoft 365 Affichage information de plusieurs cellules à partir d'une seule
Réponses
8
Affichages
216
narkoleptik
N
S
  • Résolu(e)
Microsoft 365 [Résolu] Aide sur gestionnaires de noms + liste déroulante en cascade associée
Réponses
9
Affichages
670
djidji59430
djidji59430

Membres actuellement en ligne

28 membres et 297 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 102
Messages
2 116 219
Membres
112 690
dernier inscrit
noureddinee