Discussion :

[roadrunner34]

bonjour
j'ai besoin d'identifier sur deux colonnes les valeurs identiques et de les "flaguer" par une lettre différente un peu comme pour un lettrage comptable.
dans la colonne "c" j'ai des numéros de factures, dans la colonne "d" j'ai du texte plus ces numéros de factures concaténés.
l'idée c'est de sélectionner la première cellule de C et de rechercher ce "texte" dans "D".
si rien n'est trouvé passer à la suivante.
Si une correspondance est trouvé, il faudrait indiquer en face de chaque cellule dans une troisième colonne une lettre identique aux valeurs recherchées et trouvées.
puis passer à la cellule suivante etc ...
exemple dans la PJ où surligné en jaune on voit les valeurs communes marqués en "a", en bleu idem marqué en "b" et ainsi de suite.
merci de votre aide

Classeur2.xlsx

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
Dim R As Range
Dim L As Long
Dim i As Long
Dim Occurrence As Long
Dim trouve As Boolean
Set R = ActiveSheet.UsedRange
Occurrence = 0
For i = 2 To R.Rows.Count
    L = 1
trouve = False
    Do While L <> 0
        L = SerchXls(ActiveSheet.Range("d:d"), ActiveSheet.Range("d" & L), R(i, 3), False)
        If L > 0 Then
        If trouve = False Then Occurrence = Occurrence + 1
        trouve = True
        R(i, 5) = CalculOccurence(Occurrence)
        R(L, 6) = R(i, 5)
        End If
    Loop
Next
End Sub
 
Function CalculOccurence(Occurrence) As String
Dim t As String
Dim C As Integer
Dim ICH As Integer
C = Occurrence
t = Space(Occurrence)
ICH = 0
For i = 0 To Occurrence - 1
    If Mid(t, C, 1) = "Z" Then
        Mid(t, C, 1) = "A": C = C - 1
        ICH = 0
   End If
 
       Mid(t, C, 1) = Chr(65 + ICH)
       ICH = ICH + 1
 
 
Next
CalculOccurence = Trim(t)
End Function
 
 
Function SerchXls(MyRange As Range, MyCellule As Range, strRecherche, EntierCell As Boolean) As Long '
On Error Resume Next
SerchXls = 0
Dim myxLookAt As Integer
If EntierCell = True Then myxLookAt = xlWhole Else myxLookAt = xlPart
   SerchXls = MyRange.Cells.Find(What:=strRecherche, After:=MyCellule, LookIn:=xlFormulas, LookAt _
        :=myxLookAt, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, MatchByte:=False).Row
  If SerchXls <= MyCellule.Row Then SerchXls = 0
End Function

[roadrunner34]

Bonsoir Robert
merci pour le code qui est totalement opérationnel !
Trop TOP !!

que se passe t il à la 27 occurrence ? après le Z ?

[Invité]

AA
BA
CA
ZA
AAA
BAA
CAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA

[roadrunner34]

Bravo Robert
je viens de tester avec plus de valeurs
c'est excellentissime !!

MERCI MERCI
Tu mérite bien le nom d'expert !!

[roadrunner34]

Sur une liste de 500 lignes
Le calcul Excel semble s'affoler puis Excel plante...

[Invité]

Sur une liste de 500 lignes
Le calcul Excel semble s'affoler puis Excel plante...

je suis allé très loin !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
Dim R As Range
Dim L As Long
Dim i As Long
Dim Occurrence As Long
Dim trouve As Boolean
Set R = ActiveSheet.UsedRange
Occurrence = 0
For i = 2 To R.Rows.Count
    L = 1
trouve = False
    If Trim("" & R(i, 3)) <> "" Then
        Do While L <> 0
            L = SerchXls(ActiveSheet.Range("d:d"), ActiveSheet.Range("d" & L), R(i, 3), False)
            If L > 0 Then
            If trouve = False Then Occurrence = Occurrence + 1
            trouve = True
            R(i, 5) = CalculOccurence(Occurrence)
            R(L, 6) = R(i, 5)
            End If
        Loop
    End If
Next
MsgBox "Fin"
End Sub
 
Function CalculOccurence(Occurrence) As String
Dim t As String
Dim C As Integer
Dim ICH As Integer
C = Occurrence
t = Space(Occurrence)
ICH = 0
For i = 0 To Occurrence - 1
    If Mid(t, C, 1) = "Z" Then
        Mid(t, C, 1) = "A": C = C - 1
        ICH = 0
   End If
 
       Mid(t, C, 1) = Chr(65 + ICH)
       ICH = ICH + 1
 
 
Next
CalculOccurence = Trim(t)
End Function
 
 
Function SerchXls(MyRange As Range, MyCellule As Range, strRecherche, EntierCell As Boolean) As Long '
On Error Resume Next
SerchXls = 0
Dim myxLookAt As Integer
If EntierCell = True Then myxLookAt = xlWhole Else myxLookAt = xlPart
   SerchXls = MyRange.Cells.Find(What:=strRecherche, After:=MyCellule, LookIn:=xlFormulas, LookAt _
        :=myxLookAt, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, MatchByte:=False).Row
  If SerchXls <= MyCellule.Row Then SerchXls = 0
End Function