Valeurs 1 ou 2 ou 3 dans col G en fonction nombre dans col A

Le
christian
Bonjour à tous et toutes
Je souhaiterais pouvoir obtenir la valeur 1, 2 ou 3 dans la colonne G
suivant la valeur trouvée en colonne A.
Exemple:
A B C G
100 1 Le principe serait d'indiquer le
chiffre 1 si les 3 lignes mentionnent le même n°,
100 1 le chiffre 2 si les 2 lignes
mentionnent le même n° ou le chiffre 3 pour 1 seul n°.
100 1 En fonction des chifres renseignés,
une routine se déclenchera.
101 2
101 2 En vous remerciant d'avance pour
toute aide éventuelle que vous voudrez bien
103 1 m'accordée.
103 1
103 1 Cordialement
104 3 Christian
105 1
105 1
105 1
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
michdenis
Le #23132351
Bonjour,

Une façon de faire :

Tu dois ajouter la référence suivante :
Fenêtre de l'éditeur de code / barre des menus / outils / référence /
et tu coches celle-ci : "Microsoft Scripting Runtime"

Il est supposé que tu as une étiquette de colonne en A1
que les données débutent en A2.

'-----------------------------------------
Sub test()
'Référence ajoutée :"Microsoft Scripting Runtime"
Dim Rg As Range, Cell As Range, C As Long, B As Integer
Dim Dic As New Scripting.Dictionary, Crit As Long

Application.ScreenUpdating = False
C = 0
With Sheet1
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.Sort key1:=.Item(2, 1), order1:=xlAscending, Header:=xlYes
For Each Cell In .Offset(1).Resize(.Rows.Count - 1).Cells
If Dic.Exists(Cell.Value) Then
Else
C = C + 1
Dic.Add Cell.Value, CStr(C)
End If
Next
For a = 0 To Dic.Count - 1
Crit = Dic.Keys(CStr(a))
.Resize(.Rows.Count + 1).AutoFilter field:=1, Criteria1:=Crit
B = B + 1
.Offset(1, 6).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) = B
If B = 3 Then B = 0
Next
.AutoFilter
End With
End With
Application.ScreenUpdating = True
End Sub
'-----------------------------------------



MichD
--------------------------------------------
christian
Le #23132451
On 16 fév, 20:07, "michdenis"
Bonjour,

Une fa on de faire :

Tu dois ajouter la r f rence suivante :
Fen tre de l' diteur de code / barre des menus / outils / r f rence /
et tu coches celle-ci : "Microsoft Scripting Runtime"

Il est suppos que tu as une tiquette de colonne en A1
que les donn es d butent en A2.

'-----------------------------------------
Sub test()
'R f rence ajout e :"Microsoft Scripting Runtime"
Dim Rg As Range, Cell As Range, C As Long, B As Integer
Dim Dic As New Scripting.Dictionary, Crit As Long

Application.ScreenUpdating = False
C = 0
With Sheet1
    With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
        .Sort key1:=.Item(2, 1), order1:=xlAscending, Header: =xlYes
        For Each Cell In .Offset(1).Resize(.Rows.Count - 1).Cells
            If Dic.Exists(Cell.Value) Then
            Else
                C = C + 1
                Dic.Add Cell.Value, CStr(C)
            End If
        Next
        For a = 0 To Dic.Count - 1
            Crit = Dic.Keys(CStr(a))
            .Resize(.Rows.Count + 1).AutoFilter field:=1, C riteria1:=Crit
            B = B + 1
            .Offset(1, 6).Resize(.Rows.Count - 1).SpecialCell s(xlCellTypeVisible) = B
            If B = 3 Then B = 0
        Next
        .AutoFilter
    End With
End With
Application.ScreenUpdating = True
End Sub
'-----------------------------------------

MichD
--------------------------------------------



Bonsoir MichDenis

Merci de m'avoir lu et répondu.
Ne possédant pas le programme Excel sous la main, je testerai la
soluce demain et vous tiendrai au courant.
Cordialement
Christian
Jean-Claude
Le #23132441
Bonjour,

jolie macro, mais ce ne serait pas plus simple avec une formule :
=4-NB.SI(A:A;"="&A1)
à copier en G1, et à recopier dans les lignes suivantes ?

Jean-Claude
christian
Le #23132431
On 16 fév, 20:22, "Jean-Claude"
Bonjour,

jolie macro, mais ce ne serait pas plus simple avec une formule :
=4-NB.SI(A:A;"="&A1)
à copier en G1, et à recopier dans les lignes suivantes ?

Jean-Claude



Bonsoir Jean-Claude

Merci de m'avoir lu et répondu.
Effectivement, cela fonctionne très bien.
Remerciements
Christian
michdenis
Le #23132801
Je suppose qu'il fallait deviner que dans la colonne A, il ne pouvait y
avoir une valeur identique qui se répète sur 3 lignes consécutives !


MichD
--------------------------------------------
Publicité
Poster une réponse
Anonyme