Problème logique... formule manquante... VBA ?
Bonjour,
J'ai un problème un peu original. J'ai beau le tourner dans tous les sens depuis 3 jours, je ne trouve pas de solution.
J'ai des listes de références (le fichier ci-joint contient l'exemple de l'une de ces listes de références).
En voici un extrait :
c
c:c
c:c:c
c:c:c:c
c:c:c:c:c
c:c:c:c:c:c
c:c:c:c:c:b147
c:c:c:c:c:b147:f
c:c:c:c:c:b147:c
c:c:c:c:c:b147:b412
c:c:c:c:c:b147:b412:f
c:c:c:c:c:b147:b412:c
c:c:c:c:c:b147:b412:b795
c:c:c:c:c:b147:b412:b795:f
c:c:c:c:c:b147:b412:b795:c
c:c:c:c:c:b147:b795
c:c:c:c:c:b147:b795:f
c:c:c:c:c:b147:b795:c
c:c:c:c:c:b210
c:c:c:c:c:b210:f
c:c:c:c:c:b210:c
c:c:c:c:c:b210:b795
c:c:c:c:c:b210:b795:f
c:c:c:c:c:b210:b795:c
c:c:c:c:c:b315
c:c:c:c:c:b315:f
c:c:c:c:c:b315:c
c:c:c:c:c:b315:b795
c:c:c:c:c:b315:b795:f
c:c:c:c:c:b315:b795:c
c:c:c:c:c:b420
c:c:c:c:c:b420:f
c:c:c:c:c:b420:c
c:c:c:c:c:b420:b795
c:c:c:c:c:b420:b795:f
c:c:c:c:c:b420:b795:c
c:c:c:c:c:b795
c:c:c:c:c:b795:f
c:c:c:c:c:b795:c
c:c:c:c:b147
c:c:b147:c:c:b397
c:c:b147:c:c:b397:f
c:c:b147:c:c:b397:c
c:c:b147:c:c:b397:b795
c:c:b147:c:c:b397:b795:f
c:c:b147:c:c:b397:b795:c
c:c:b147:c:c:b504
c:c:b147:c:c:b504:f
c:c:b147:c:c:b504:c
Ces références fonctionnent comme des catégories / sous-catégories séparées par des ":". Chaque catégorie peut être de type "c", "b" ou "f".
Par exemple, c:c:c:c:c:b420 représente la référence de la sous-catégorie b420, dans la sous-catégorie "c" de la sous-catégorie "c" de la sous-catégorie "c" de la sous-catégorie "c" de la catégorie "c".
La première lettre (à gauche) représente la 1ère catégorie, puis les sous-catégories déroulent comme des tiroirs.
J'espère que c'est clair jusqu'ici
Ma problématique est de remplacer les nombres accolés à "b" par leur rang parmi les valeurs accolées à "b" dans la sous-catégorie concernée.
Par exemple :
"c:c:c:c:c:b147" et "c:c:c:c:c:b210" et "c:c:c:c:c:b315" et "c:c:c:c:c:b420" sont toutes les sous-catégories de type "b" appartenant toutes à la catégorie "c:c:c:c:c:"
Or 147<210<315<420
Donc je voudrais remplacer "c:c:c:c:c:b147" et "c:c:c:c:c:b210" et "c:c:c:c:c:b315" et "c:c:c:c:c:b420" par "c:c:c:c:c:b1" et "c:c:c:c:c:b2" et "c:c:c:c:c:b3" et "c:c:c:c:c:b4" : chaque nombre a été remplacé par son rang (ordre croissant) parmi les nombres présents dans sa catégorie.
A noter qu'après ce remplacement, "c:c:c:c:c:b147" (par exemple) n'existera plus, même dans des références des catégories filles, telles que ci-dessous :
c:c:c:c:c:b147:b412
c:c:c:c:c:b147:b412:f
c:c:c:c:c:b147:b412:c
La sous-catégories "c:c:c:c:c:b147" sera devenue "c:c:c:c:c:b1".
A la fin du process, tous les nombres accolés à b, à quelques emplacements que ce soit dans la référence ("b147:c:b504:c:c:b795:f" par exemple) devront avoir été remplacés par leur rang.
J'espère que c'est clair.
J'ai essayé avec des formules, des calculs intermédiaires, mais je galère.
La solution peut venir du VBA mais je n'y connais pas grand chose
Merci de votre aide !
Bonjour,
une proposition (j'ai fait l'hypothèse que le rang des b est indépendant de la sous-catégorie)
Option Explicit
Sub aargh()
Dim dict As Object
Dim dl&, i&, j&, k&, ov$, nv$
Dim ref, a, t, tmp
With Sheets("feuil1")
Set dict = CreateObject("scripting.dictionary")
dl = Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne
ref = .Range("A2").Resize(dl - 1, 1) 'table des références
For i = 2 To dl - 1
t = Split(ref(i, 1), ":")
For j = LBound(t) To UBound(t)
If Left(t(j), 1) = "b" Then dict(t(j)) = 1 'on ajoute au dictionnaire les références qui commencent par b
Next j
Next i
a = dict.keys ' dictionnaire dans le tableau a
'tri du tableau a en ordre croissant
For i = LBound(a) To UBound(a) - 1
For j = i + 1 To UBound(a)
If a(i) > a(j) Then tmp = a(i): a(i) = a(j): a(j) = tmp
Next j
Next i
'remplacement des références
With .Range("A2").Resize(dl, 1)
k = 0
For i = LBound(a) To UBound(a)
k = k + 1
ov = a(i)
nv = "b" & k
.Replace ov, nv, lookat:=xlPart
Next i
End With
End With
End Sub
Nicopat,
Autre proposition :
Option Explicit
Sub trfCCCCCB()
Dim oSheet As Worksheet
Dim oRange As Range
Dim oCell As Range
Dim aRef() As String
Dim i As Integer, j As Integer
Set oSheet = ThisWorkbook.Sheets(1)
Set oRange = oSheet.UsedRange.Columns(1)
'On boucle sur la plage de cellules de la colonne "A"
For Each oCell In oRange.Rows
'On charge une table mémoire avec la valeur de la cellules en séparant les sous-chaines délimitées par le séparateur ":"
aRef = Split(oCell.Value, ":")
i = UBound(aRef)
'Si la dimension du tableau est de 6 éléments, on traite
If i = 5 Then
'Si la première position du 6ème élément est "b", on traite
If Left(aRef(5), 1) = "b" Then
'On ajoute 1 au compteur
j = j + 1
'On replace dans toutes les cellules de la colonne "A" tout ce qui est égal au 6ème élément du tableau par "b"+Compteur
oRange.Replace "" & aRef(5), "b" & CStr(j), xlPart
End If
End If
Next
MsgBox "Fin Conversion"
'On fait le ménage
Set oSheet = Nothing
Set oRange = Nothing
End Sub
Je joins mon classeur de test.