Récupérer les valeurs de cellules sous certaines conditions
Bonjour à tous,
Je travaille en VBA. J'ai un tableau comme suit. Je veux récupérer les valeurs UAI pour lesquelles j'ai la valeur max dans la colonne contiguë soit VSO.
Ex : je veux récupérer automatiquement 0320025D et 0320030J à partir de la valeur maximum recherchée dans VSO.
J'ai fait la première partie du travail mais je n'obtiens que la première valeur UAI.
Dim adress As Object
Dim x2max As Integer
dim line as integer
x2max = Workbooks(InputFilename).Sheets(OutputSheetName).Cells(Rows.count, "C").End(xlUp).Row
Set adress = [E:E].Find(What:=Application.WorksheetFunction.Max(Workbooks(InputFilename).Sheets(OutputSheetName).Range("E1:E" & x2max)), LookAt:=xlPart)
line = adress.RowUne petite suggestion ?
S'il y a plus simple, n'hésitez pas...
Les boucles entraînant une augmentation du temps d'exécution, je préfère les éviter... mais je prends quand même !
Bonsoir,
quand vous dites récupérer, ça veut dire les afficher dans une autre partie de la feuille ?
Par formule c'est plus simple, ex. ;
=SIERREUR(INDEX($A$2:$A$11;PETITE.VALEUR(SI($B$2:$B$11=MAX($B$2:$B$11);LIGNE($B$2:$B$11)-1);LIGNE(1:1)));"")Bonjour,
Euh, je suis contrains de travailler sous VBA. Récupérer signifie prendre la valeur et la copier autre part. Par exemple, la placer dans une autre cellule d'une autre feuille de calcul...
Votre formule signifie de travailler directement sur la feuille de calcul. Je dois faire usage de VBA.
Merci tout de même du temps consacré pour cette formule.
Bonjour ,
Essayez ceci, à adapter à votre fichier:
Sub Recup_Valeurs_Max()
Dim f1 As Worksheet, f2 As Worksheet
Dim DerLig_f1 As Long, ValeurMax As Long
Dim d1 As Object
Dim C As Range
Application.ScreenUpdating = False
Set f1 = Sheets("Feuil1") 'f1=feuille contenant les données
Set f2 = Sheets("Feuil2") 'f2=feuille destinée à recevoir les résultats
f2.Columns("A").Clear 'suppression des résultats précédents dans la "Feuil2"
DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row 'Dernière ligne de la "Feuil1"
ValeurMax = Application.Max(Range(f1.Cells(2, "B"), f1.Cells(DerLig_f1, "B"))) 'Valeur max à rechercher
Set d1 = CreateObject("Scripting.Dictionary") 'création d'un dictionnaire
For Each C In f1.Range("B2:B" & DerLig_f1) 'lecture de toutes les cellules de la colonne B de la "Feuil1"
If C.Value = ValeurMax Then d1(C.Offset(0, -1).Text) = "" 'conservation de l'UAI correspondante si la valeur max est trouvée
Next C
If d1.Count > 0 Then
f2.Range("A1").Resize(d1.Count, 1) = Application.Transpose(d1.keys) 'Restitution du résultat dans la colonne A de la "Feuil2"
End If
Set d1 = Nothing
Set f1 = Nothing
Set f2 = Nothing
Application.ScreenUpdating = False
End SubCdlt
bonjour Aphrodite, salut Arturo83, Doux Reveur,
Sub Aphrodite()
Dim c, dMax, s, Arr, i
Dim Inputfilename: Inputfilename = "trial.xlsm"
Dim Outputsheetname: Outputsheetname = "feuil1"
With Workbooks(Inputfilename).Sheets(Outputsheetname) 'cette feuille dans ce fichier
Set c = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row) 'plage "VSO"
dMax = Application.Max(c) 'la valeur max de cette plage
Arr = c.Offset(, -1).Resize(, 2).Value2 'matrice avec les valeurs des colonnes UAI et VSO
End With
For i = 2 To UBound(Arr) 'boucler les données
If Arr(i, 2) = dMax Then s = s & vbLf & Arr(i, 1) 'VSO est valeur max,alors ajouter UAI às avec vblf comme séparateur
Next
If Len(s) > 0 Then 'on a trouvé des valeurs max
sp = Split(Mid(s, 2), vbLf) 'séprarer le résultat dans une matrice sp
MsgBox Mid(s, 2) 'msgbox avec le résultat
Else
MsgBox "vide"
End If
End Subou avec un dictionaire au lieu d'un string comme Arturo83 l'a fait
Sub Aphrodite()
Dim c, dMax, s, Arr, i
Dim Inputfilename: Inputfilename = "trial.xlsm"
Dim Outputsheetname: Outputsheetname = "feuil1"
Dim Dict: Set Dict = CreateObject("scripting.dictionary"): Dict.comparemode = vbTextCompare
With Workbooks(Inputfilename).Sheets(Outputsheetname) 'cette feuille dans ce fichier
Set c = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row) 'plage "VSO"
dMax = Application.Max(c) 'la valeur max de cette plage
Arr = c.Offset(, -1).Resize(, 2).Value2 'matrice avec les valeurs des colonnes UAI et VSO
End With
For i = 2 To UBound(Arr) 'boucler les données
If Arr(i, 2) = dMax Then Dict(Arr(i, 1)) = vbEmpty 'VSO est valeur max,alors ajouter au dictionaire
Next
If Dict.Count > 0 Then 'on a trouvé des valeurs max
MsgBox Join(Dict.keys, vbLf) 'msgbox avec le résultat
Else
MsgBox "vide"
End If
End SubBonjour à vous,
J'ai fait des essais. Tout fonctionne. Je ne suis pas habitué à utiliser des dictionnaires. Il faut s'y mettre...
Maintenant, j'essaie d'inclure tout ça dans une boucle car il y a plusieurs colonnes sur lesquelles travailler, dont il faut repérer la valeur maximum.
Merci de votre contribution.
Je n'ai plus trop le temps de chercher une solution pour parcourir 5 colonnes successives. Je laisse tomber ça...
Si vous m'en disiez un peu plus, je pourrai vous le faire.
Je ne suis pas loin de la solution mais je ne peux plus y passer trop de temps. C'est frustrant. Il s'agit d'étendre le travail sur une colonne à un ensemble de colonnes. On veut pour chaque colonne colorée déterminer l'UAI de la colonne 1 ou "A" correspondant pour chaque valeur maximum.
C'est pas clair, faut-il prendre la valeur max sur l'ensemble des colonnes ou bien la valeur max par colonne, et quelle sera la dernière colonne?
Désolé pour l'attente, j'étais pris...
C'est la valeur max pour chacune des colonnes B,C,D,E,F,G,H,I,J,K soit 10 colonnes.
Ex : pour "VSO", valeur_max =6 donc UAI=0320025D
Ex : pour "AO", valeur_max =3 donc UAI=0320067Z
etc...
Je suppose qu'il faut traiter chaque colonne individuellement alors essayez ceci:
Cdlt
Ps: Pas rafraichit l'affichage, BsAlv à été plus rapide