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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
Sub Develo()
Dim CellSource As Range
Dim CellDest As Range
Dim Sh As Worksheet
Dim ListeCode As String
Application.ScreenUpdating = False
' la liste qui va recenser les codes déjà trouvés
ListeCode = "|"
Set Sh = ThisWorkbook.Worksheets("Le Nom de Ta Feuille")
With Sh
' pour chaque cellule contenant un code
For Each CellSource In .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Cells
' si on ne trouve pas le code qu'on cherche
If Not ListeCode Like "*" & "|" & CellSource & "|" & "*" Then
' on ajoute le code dans la liste (avec un simple séparateur pour ôter les biais)
ListeCode = ListeCode & CellSource & "|"
' on prend la première cellule non vide en G
Set CellDest = .Range("G" & Rows.Count).End(xlUp)(2)
' on y écrit la valeur
CellDest.Offset(0, 1) = CellSource
' on indique en colonne H le code qui s'y rapporte
CellDest = CellSource.Offset(0, 2)
' si le code qu'on teste est déjà dans la liste
Else
' on cherche dans le listing des codes déjà recencés en colonne H
For Each CellDest In .Range("H2", .Range("H" & Rows.Count).End(xlUp)).Cells
' dès qu'on a trouvé le code
If CellDest = CellSource Then
' on ajoute la nouvelle quantitée
CellDest.Offset(0, -1) = CellSource.Offset(0, 2) + CellDest.Offset(0, -1)
Exit For
End If
Next CellDest
End If
Next CellSource
End With
Set Sh = Nothing
Application.ScreenUpdating = True
End Sub |
