Problème logique... formule manquante... VBA ?

Le 25/10/2019 à 12:40

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 !

4exemple.xlsx (14.89 Ko)
Le 25/10/2019 à 15:00

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
Le 25/10/2019 à 16:37

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.

1exemple-gvs.xlsm (29.75 Ko)
Rechercher des sujets similaires à "probleme logique formule manquante vba"