Valeurs 1 ou 2 ou 3 dans col G en fonction nombre dans col A
5 réponses
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
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
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 '-----------------------------------------
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
'-----------------------------------------
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 '-----------------------------------------
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 '-----------------------------------------
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
On 16 fév, 20:07, "michdenis" <michde...@hotmail.com> 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
'-----------------------------------------
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
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 '-----------------------------------------
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
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
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 ?