Résolu Position d'un chiffre selon critère

[Mitch]

Bonjour, ce bout de code me positionne le chiffre 1 suivant la colonne A, j'aimerais avoir le chiffre 2 suivant la colonne A et B
Je joint mon fichier pour mieux me faire comprendre

Merci


Dim derlig&, mondico As Object
Set mondico = CreateObject("scripting.dictionary")
With Sheets("declinaisons")
derlig = .Range("A" & .Rows.Count).End(xlUp).Row
For Each c In .Range("A2:A" & derlig)
If Not mondico.exists(c.Value) Then
mondico(c.Value) = mondico(c.Value)
c.Offset(, 11) = 1
c.Offset(, 12) = 1
End If
Next c
End With

 

[mapomme]

Re : Position d'un chiffre selon critère

Bonsoir Mitch,

Un essai de réponse qui ne répond pas tout à fait à la question puisqu'il utilise des formules et non du code VBA 🙁

En cellule P2 et Q2, placez la valeur 1.

En cellule P3, la formule suivante à copier vers le bas:

=SI(A3<>A2;1;"")

En cellule Q3, la formule suivante à copier vers le bas:

=SI(P3=1;1;SI(GAUCHE(B3;TROUVE(",";B3)-1)=GAUCHE(B2;TROUVE(",";B2)-1);"";NB.SI.ENS($A$2:A2;A3;$M$2:M2;">=1")+1))

nb: le tableau doit être trié suivant la colonne ID en clef une et suivant la colonne Options en clef deux.

 

[mapomme]

Re : Position d'un chiffre selon critère

Bonjour Mitch,

Deux macros devant aboutir au résultat (code dans module 1)
Sub AjouteNumDFormul() qui passe par des formules (voir post #2) et Sub AjouteNumDico() utilisant un objet scripting.dictionary.

Code AjouteNumDFormul() :

Sub AjouteNumDFormul()
Const Sep = "]"
Dim Zone As Range
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
  
  .Range("L2") = 1: .Range("M2") = 1
  Set Zone = .Range("A" & .Rows.Count).End(xlUp)
  Set Zone = .Range(.Range("A3"), Zone)
  
  Zone.Offset(, 11).FormulaR1C1 = "=IF(RC[-11]<>R[-1]C[-11],1,"""")"
  Zone.Offset(, 12).FormulaR1C1 = _
    "=IF(RC[3]=1,1,IF(LEFT(RC[-11],FIND("","",RC[-11])-1)=" & _
    "LEFT(R[-1]C[-11],FIND("","",R[-1]C[-11])-1),"""",COUNTIFS" & _
    "(R2C1:R[-1]C[-12],RC[-12],R2C13:R[-1]C,"">=1"")+1))"
  Zone.Offset(, 11).Resize(, 2).Value = Zone.Offset(, 11).Resize(, 2).Value
End With
End Sub

Code AjouteNumDico() :

Sub AjouteNumDico()
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
End Sub

nb: le tableau est trié via les macros

 

[Mitch]

Re : Position d'un chiffre selon critère

Bonjour mapomme, c'est exactement ce que je voulais en VBA car en plus j'avais omis de préciser que s'il y avait une 3eme couleur il fallait en tenir compte, je te souhaite une bonne journée
Merci