Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

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

5 réponses
Avatar
christian
Bonjour =E0 tous et toutes
Je souhaiterais pouvoir obtenir la valeur 1, 2 ou 3 dans la colonne G
suivant la valeur trouv=E9e 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=EAme n=B0,
100 1 le chiffre 2 si les 2 lignes
mentionnent le m=EAme n=B0 ou le chiffre 3 pour 1 seul n=B0.
100 1 En fonction des chifres renseign=E9s,
une routine se d=E9clenchera.
101 2
101 2 En vous remerciant d'avance pour
toute aide =E9ventuelle que vous voudrez bien
103 1 m'accord=E9e.
103 1
103 1 Cordialement
104 3 Christian
105 1
105 1
105 1

5 réponses

Avatar
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, 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
--------------------------------------------
Avatar
christian
On 16 fév, 20:07, "michdenis" wrote:
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
Avatar
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
Avatar
christian
On 16 fév, 20:22, "Jean-Claude" wrote:
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
Avatar
michdenis
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
--------------------------------------------