chiffre selon 2 critères

M

Mitch

XLDnaute Occasionnel
Bonjour, je voudrais afficher le chiffre 1 dans la colonne L suivant 2 critères: colonne A et colonne J
je m'explique:

Le chiffre 1 doit s'afficher une seule fois par ID (colonne A)
et en prenant la plus gosse Qte (collonne J)

J'espere que mes explications sont claires car c'est pas evidant

Merci


Je remercie mapomme qui m'avait fourni une macro , le fichier depuis à évoluer
 

Pièces jointes

  • test.xlsm
    48.9 KB · Affichages: 40
  • test.xlsm
    48.9 KB · Affichages: 41
  • test.xlsm
    48.9 KB · Affichages: 42
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Re : chiffre selon 2 critères

Bonjour,

Juste une amélioration du code de JHA, pour que le 1 ne s'affiche bien qu'une seule fois par ID :

Code: 
=SI(LIGNE()=1+EQUIV(MAX(($A$2:$A$17=A2)*$J$2:$J$17);($A$2:$A$17=A2)*$J$2:$J$17;0);1;"")
En effet le maximum en colonne J peut exister plus d'une fois.

Fichier joint.

A+
 

Pièces jointes

  • test(1).xls
    263.5 KB · Affichages: 39
  • test(1).xls
    263.5 KB · Affichages: 36
  • test(1).xls
    263.5 KB · Affichages: 36
Vote positif 0 Vote négatif
M

Mitch

XLDnaute Occasionnel
Re : chiffre selon 2 critères

Bonsoir job75 , je ne peut pas avoir de formule dans la feuille car quand je copie ma feuille mes anciennes données sont effacée

voici le code que m'avait fait mapomme mais ça concernait la colonne L et M ,en colonne L il prenait la première ID (colonne A)

Const Sep = "]"
Dim mondico, Zone As Range, xCell As Range, xID, xCoul, nMax
Set mondico = CreateObject("scripting.dictionary")

With Sheets("declinaisons")
Set Zone = .Range("A" & .Rows.Count).End(xlUp)
Set Zone = .Range(.Range("A1"), Zone.Offset(, 10))
Zone.Sort key1:=Zone.Columns(1), key2:=Zone.Columns(2), Header:=xlYes

Set Zone = .Range("A" & .Rows.Count).End(xlUp)
Set Zone = .Range(.Range("A2"), Zone)
For Each xCell In Zone
xID = xCell.Value
xCoul = Left(xCell.Offset(, 1), InStr(xCell.Offset(, 1), ",") - 1) & Sep
If Not mondico.exists(xID) Then
mondico(xID) = "1" & Sep & xCoul
xCell.Offset(, 11) = 1: xCell.Offset(, 12) = 1
Else
If InStr(mondico(xID), xCoul) = 0 Then
nMax = Val(Left(mondico(xID), InStr(mondico(xID), Sep) - 1)) + 1
mondico(xID) = nMax & Sep & Mid(mondico(xID), InStr(mondico(xID), Sep) + 1) & xCoul
xCell.Offset(, 11) = "": xCell.Offset(, 12) = nMax
Else
xCell.Offset(, 11) = "": xCell.Offset(, 12) = ""
End If
End If
Next xCell
End With
 
Dernière édition:
Vote positif 0 Vote négatif
youky(BJ)

youky(BJ)

XLDnaute Barbatruc
Re : chiffre selon 2 critères

Bonjour,
Je viens de faire cette macro qui fonctionne
Voir aussi le fichier
Bruno
Code: 
Private Sub CommandButton1_Click()
ID = [A2]
For Each c In Range("A2:A" & [A65000].End(3).Row + 1)
If Cells(c.Row, 1) = ID And Cells(c.Row, 10) > qte Then qte = Cells(c.Row, 10): lig = c.Row
If Cells(c.Row, 1) <> ID Then
ID = Cells(c.Row, 1): qte = Cells(c.Row, 10)
If c.Row > 1 Then Cells(lig, 12) = 1: lig = c.Row
End If
Next
End Sub
 

Pièces jointes

  • test (2).xlsm
    53.3 KB · Affichages: 32
  • test (2).xlsm
    53.3 KB · Affichages: 41
  • test (2).xlsm
    53.3 KB · Affichages: 38
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : chiffre selon 2 critères

Re,

Si vous ne voulez pas de formules dans les cellules, VBA peut les entrer puis les supprimer :

Code: 
Sub Default()
Dim derlig As Long, f$, cel As Range
derlig = Cells(Rows.Count, 1).End(xlUp).Row
If derlig = 1 Then Exit Sub
Application.ScreenUpdating = False
Range("L2:L" & Rows.Count).ClearContents
f = "(R2C1:R" & derlig & "C1=RC1)*R2C10:R" & derlig & "C10"
With Range("L2:L" & derlig)
  .FormulaR1C1 = "=IF(ROW()=1+MATCH(MAX(" & f & ")," & f & ",0),1,"""")"
  .FormulaArray = .FormulaR1C1 'matricielle
  .Value = .Value 'supprime les formules
End With
End Sub
Fichier joint, clic sur le bouton.

A+
 

Pièces jointes

  • test VBA(1).xls
    332 KB · Affichages: 28
  • test VBA(1).xls
    332 KB · Affichages: 30
  • test VBA(1).xls
    332 KB · Affichages: 35
Vote positif 0 Vote négatif
M

Mitch

XLDnaute Occasionnel
Re : chiffre selon 2 critères

Merci youky(BJ) ça fonctionne très bien , mais comment faut-il le positionner dans mon code pour qu'il ce déclenche en même temps , car la tu as mis un bouton mais moi j'en ai deja un :confused:

Merci
 
Dernière édition:
Vote positif 0 Vote négatif
youky(BJ)

youky(BJ)

XLDnaute Barbatruc
Re : chiffre selon 2 critères

Tu mets le code dans ton bouton sans tenir compte de la 1ère et dernière ligne.
Ou à la suite de ton code
Ou si c'est un bouton de formulaire et tu lui affecte default
Code: 
Sub default()
ID = [A2]
For Each c In Range("A2:A" & [A65000].End(3).Row + 1)
If Cells(c.Row, 1) = ID And Cells(c.Row, 10) > qte Then qte = Cells(c.Row, 10): lig = c.Row
If Cells(c.Row, 1) <> ID Then
ID = Cells(c.Row, 1): qte = Cells(c.Row, 10)
If c.Row > 1 Then Cells(lig, 12) = 1: lig = c.Row
End If
Next
End Sub

Bruno
 
Vote positif 0 Vote négatif
M

Mitch

XLDnaute Occasionnel
Re : chiffre selon 2 critères

Bonsoir , bon désolé mais je suis nul en macro et je n'arrive pas à insérer le bout de code j'ai toujours une erreur
voici mon code existant avec le bout de code mis à la suite ,fourni par youky(BJ)

Sub copier()
Dim i As Long, fin As Long, a As Integer
Feuil2.Range("A2:XFD1048576").Clear
Feuil1.Range("A2:XFD1048576").Clear
fin = Feuil4.Range("A65000").End(xlUp).Row
For i = 2 To fin
For a = 1 To Feuil4.Cells(i, 22)
Feuil4.Range("A" & i).Copy Feuil2.Range("A65000").End(xlUp).Offset(1, 0)
Feuil4.Range("M" & i).Copy Feuil2.Range("C65000").End(xlUp).Offset(1, 0)
Feuil2.Range("K65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("T" & i).Value
Next a
For a = 1 To Feuil4.Cells(i, 74)
Feuil4.Range("W" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("X" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("Y" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("Z" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AA" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AB" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AC" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AD" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AE" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AF" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AG" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AH" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AI" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AJ" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AK" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AL" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AM" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AN" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AO" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AP" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AQ" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AR" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AS" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AT" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AU" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AV" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AW" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AX" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AY" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("AZ" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("BA" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("BB" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("BC" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("BD" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("BE" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("BF" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("BG" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("BH" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Feuil4.Range("BI" & i).Copy Feuil2.Range("J65000").End(xlUp).Offset(1, 0)
Feuil4.Range("BJ" & i).Copy Feuil2.Range("B65000").End(xlUp).Offset(1, 0)
Next a
Feuil1.Range("A65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("A" & i).Value
Feuil1.Range("B65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("B" & i).Value
Feuil1.Range("C65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("C" & i).Value
Feuil1.Range("D65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("D" & i).Value
Feuil1.Range("E65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("CQ" & i).Value
Feuil1.Range("F65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("F" & i).Value
Feuil1.Range("G65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("G" & i).Value
Feuil1.Range("H65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("H" & i).Value
Feuil1.Range("I65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("I" & i).Value
Feuil1.Range("J65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("J" & i).Value
Feuil4.Range("K" & i).Copy Feuil1.Range("K65000").End(xlUp).Offset(1, 0)
Feuil4.Range("L" & i).Copy Feuil1.Range("L65000").End(xlUp).Offset(1, 0)
Feuil1.Range("M65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("M" & i).Value
Feuil1.Range("N65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("N" & i).Value
Feuil1.Range("O65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("O" & i).Value
Feuil1.Range("P65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("P" & i).Value
Feuil1.Range("Q65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("Q" & i).Value
Feuil1.Range("R65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("R" & i).Value
Feuil1.Range("S65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("S" & i).Value
Feuil1.Range("T65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("T" & i).Value
Feuil1.Range("U65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("U" & i).Value
Feuil1.Range("V65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("CL" & i).Value
Feuil1.Range("W65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BL" & i).Value
Feuil1.Range("X65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BM" & i).Value
Feuil1.Range("Y65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BN" & i).Value
Feuil1.Range("Z65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BO" & i).Value
Feuil1.Range("AA65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BP" & i).Value
Feuil1.Range("AB65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BQ" & i).Value
Feuil1.Range("AC65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BR" & i).Value
Feuil1.Range("AD65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BS" & i).Value
Feuil1.Range("AE65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BT" & i).Value
Feuil4.Range("BU" & i).Copy Feuil1.Range("AF65000").End(xlUp).Offset(1, 0)
Feuil1.Range("AG65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BV" & i).Value
Feuil1.Range("AI65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BW" & i).Value
Feuil1.Range("AH65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("CK" & i).Value
Feuil1.Range("AK65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("BY" & i).Value
Feuil1.Range("AL65000").End(xlUp).Offset(1, 0).Value = Feuil4.Range("CM" & i).Value
Next i

ID = [A2]
For Each c In Range("A2:A" & [A65000].End(3).Row + 1)
If Cells(c.Row, 1) = ID And Cells(c.Row, 10) > qte Then qte = Cells(c.Row, 10): lig = c.Row
If Cells(c.Row, 1) <> ID Then
ID = Cells(c.Row, 1): qte = Cells(c.Row, 10)
If c.Row > 1 Then Cells(lig, 12) = 1: lig = c.Row
End If
Next

End Sub

j'ai essayer d'intégrer ceci : Dim ID As Long, c As Range, qte As Integer mais ça bloque quand même au niveau (lig,12)
 
Dernière édition:
Vote positif 0 Vote négatif
youky(BJ)

youky(BJ)

XLDnaute Barbatruc
Re : chiffre selon 2 critères

Bonsoir,
Je n'ai pas déclaré mes variables(je ne mets pas OPTION EXPLICIT qui oblige la déclaration)par fainéantise
Donc si tu as obligation de les déclarer...
Dim lig as long

Ton code peut être bien réduit mais pour cela il faudrait un fichier exemple réduit à qlq lignes
Bruno
 
Vote positif 0 Vote négatif
youky(BJ)

youky(BJ)

XLDnaute Barbatruc
Re : chiffre selon 2 critères

Salut,
Remplace le bas de la macro par cela
et en tête de macro
Dim lig as Long
Code: 
With Sheets("declinaisons")

ID = [A2]
For Each c In .Range("A2:A" & .[A65000].End(3).Row + 1)
If .Cells(c.Row, 1) = ID And .Cells(c.Row, 10) > qte Then qte = .Cells(c.Row, 10): lig = c.Row
If .Cells(c.Row, 1) <> ID Then
ID = .Cells(c.Row, 1): qte = .Cells(c.Row, 10)
If c.Row > 1 Then .Cells(lig, 12) = 1: lig = c.Row
End If
Next
End With

Bruno
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Si avec des conditions
Réponses
8
Affichages
503
milor17
M
M
  • Question
XL 2016 VBA calcul selon plusieurs critères d'optimisation
Réponses
4
Affichages
541
MR.O
M
U
  • Question
Microsoft 365 Selon chiffre saisi, signalement d'une erreur dans une formule
Réponses
5
Affichages
630
USTY_56
U
M
  • Question
XL 2019 Rang selon plusieurs critères
Réponses
12
Affichages
1 K
matmac
M
Lulu974
  • Résolu(e)
Microsoft 365 Excel Somme plusieurs critères d'une même cellule à 2 conditions
Réponses
8
Affichages
2 K
AtTheOne
AtTheOne
S
  • Question
XL 2019 VBA matrice reporter 1 seule fois la valeur la plus haute selon H puis J
Réponses
5
Affichages
646
SOSjeBloque
S
R
  • Question
Microsoft 365 Affichage sur List Box et retranscrire donnée sur cellule
Réponses
9
Affichages
914
Roger26
R
D
  • Question
Microsoft 365 Ancienneté salariés & Anniversaires professionnels
Réponses
5
Affichages
2 K
Dje_Ejd
D
F
  • Résolu(e)
XL 2013 formule multi critères mais aussi multi listes
Réponses
11
Affichages
1 K
Fabiennesd
F
sebbbbb
  • Question
XL 2010 Création de menus déroulants conditionnels en fonction de 3 paramètres situés dans 3 onglets différents
Réponses
8
Affichages
1 K
sebbbbb
sebbbbb

Membres actuellement en ligne

10 membres et 96 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
312 520
Messages
2 089 291
Membres
104 089
dernier inscrit
salimgtu