[XL-2010] Détection de valeur et numérotation incrémentée [Résolu]

[Kaera]

Bonjour à tous, chers forumeurs,

Dans ma feuille, il y a un tableau avec plusieurs colonnes (jour, numéro, code, opération).
J'ai tenté de réaliser une petite macro qui associerait à chaque "nouveau" code UN chiffre(celui-ci devant s'incrémenter).
J'explique : la macro doit parcer la colonne C, à chaque code nouvellement rencontré, elle associe un chiffre en commençant par 1.
NB: Les codes ne sont absolument pas dans l'ordre, ils sont aléatoires.
L'ordre n'est définit que par leur apparition : comme vous pouvez le voir sur le screenshot, il peut y avoir
1 1 1 2 1 1 3 2 4 (où 1 et 2 réapparaissent plus bas dans la liste) mais jamais le 4 n'apparaîtra pour la première fois avant le 3 (par exemple).

Pour faciliter la compréhension, ci-joint un screen shot de ce que ça doit donner.
Côté code (de macro cette fois-ci), j'ai tenté de passer par une liste sans doublons mais ça ne me semble pas concluant; de plus, je coince royalement à la partie où il faut à tel code associer tel numéro.
Voici :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub numerotation()
 Dim derli As Long, derliplaq As Long,
 
Sheets("Worklist").Activate
 
	derli = Range("C1048576").End(xlUp).Row
	Range("C2:C" & derli).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns("M:M"), Unique:=True
	' jusque là ça me crée ma liste sans doublons dans la colonne M (temporairement puisque je l'efface ensuite)
 
'et là... ça coince ! (oui je sais, c'est plutôt maigre)
end sub

Merci d'avance pour votre aide !

Kaera*

[mercatog]

Ci-joint proposition en utilisant une collection et des variables tableaux
(Dans Res on récuppère les Numéros et leur code respectif)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Test()
Dim LastLig As Long, i As Long, j As Long
Dim Code As New Collection
Dim Tb, Res()
 
Application.ScreenUpdating = False
With Worksheets("Worklist")
    LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row
    Tb = .Range("B2:C" & LastLig)
    For i = 1 To LastLig - 1
        On Error Resume Next
        Code.Add Tb(i, 1), CStr(Tb(i, 1))
        If Err = 0 Then
            j = j + 1
            ReDim Preserve Res(1 To 2, 1 To j)
            Res(1, j) = Tb(i, 1)
            Res(2, j) = Tb(i, 2)
        Else
            Err.Clear
        End If
        On Error GoTo 0
    Next i
    Set Code = Nothing
End With
If j > 0 Then Worksheets("Feuil2").Range("A1").Resize(j, 2) = Application.Transpose(Res)
End Sub

[Kaera]

Bonjour mercatog,

Merci beaucoup pour ton aide.
Ton code fonctionne très bien mais, malheureusement, uniquement si ma colonne numéro est déjà renseignée !
Or je l'ai indiquée (sur le screen shot) juste pour montrer à quoi doit ressembler le résultat.

Au départ j'ai la même feuille, mais la colonne "Numéro" est vide.
L'idée est donc de détecter chaque nouvelle valeur dans la colonne "Code" et de lui attribuer un numéro (qui s'incrémente), puis d'appliquer ces numéros dans toute la colonne "Numéro".
En résumé ça donne :

Ici, la macro détecte 4 codes différents apparaissant dans l'ordre suivant :
100567
100541
100583
100515

La macro va donc attribuer à chacun un numéro, en commençant par 1 :
100567 --> 1
100541 --> 2
100583 --> 3
100515 --> 4
Maintenant que chaque code a son numéro, chaque cellule de la colonne "Numéro" indiquera le numéro correspondant au code situé à sa droite (et là, voir screenshot).

NB :Dans cet exemple précis il y a 4 codes mais il faut savoir que le nombre de codes est variable.

J'espère que cette explication est plus claire que la précédente !

Merci d'avance à toi mercatog, ou tout autre membre du forum.

[mercatog]

Je comprends maintenant.
Ci-joint code adapté

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Test()
Dim LastLig As Long, i As Long, j As Long
Dim Code As New Collection
Dim Tb, Res()
 
Application.ScreenUpdating = False
With Worksheets("Worklist")
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    Tb = .Range("B2:C" & LastLig)
    For i = 1 To LastLig - 1
        On Error Resume Next
        Code.Add Tb(i, 2), CStr(Tb(i, 2))
        On Error GoTo 0
    Next i
    For j = 1 To Code.Count
        For i = 1 To LastLig - 1
            If Tb(i, 2) = Code(j) Then Tb(i, 1) = j
        Next i
    Next j
    Set Code = Nothing
    .Range("B2:C" & LastLig) = Tb
End With
End Sub

[Kaera]

Merci Mercatog pour ton aide précieuse