Recherche caractère et Somme - VBA

Bonjour,

Me voici devant une petite difficulté, que je souhaite impérativement résolver en VBA

J'ai un fichier Excel comprenant 4 colonnes :

- Une première colonne "A" avec des codes de type (RN1-ABC01 / RN1-ABC02 /...)

- Une seconde "B" correspondant à une somme

- La troisième colonne prenons "J" est remplie par d'autre code semblable a ceux de la colonne "A" (1ABC01-001 / 1ABC01-002 / 1ABC01-003 / 1ABC02-001 / 1ABC02-002 / etc...) On remarque qu'une partie du code à chaque fois correspond à une partie du code de la colonne A par exemple ABC01 et ABC02

- La quatrième colonne "K" sont des nombres associés à chaque code de la colonne "J"

Ce que j'aimerais, en VBA, c'est à partir de la colonne "A" recherche si dans la colonne "J", la partie du code correspondant au code colonne "A" = partie du code correspondant au code colonne "J" et si tel est le cas, faire dans la colonne "B" la somme de la colonne "K"

Je sais pas si c'est très clair En gros c'est une RECHERCHEV sur une partie des caractères mais cela en VBA pour ensuite faire la somme.

Si quelqu'un comprend mon soucis ^^ Je met en pièce jointe un fichier peut être plus clair.

Je vous remercie d'avance

Bonsoir,

Est-ce que la partie commune des codes est préidentifiable, soit qu'on sait que pour le 1er code c'est la partie finale du code située après le tiret, et pour le second code qu'il s'agit de la première partie avant tiret et en faisant abstraction du chiffre initial ?

Bonsoir MFerrand,

Il s'agit bien de la partie finale situé après le tiret pour le 1er code et la première partie avant tiret en faisant abstraction du chiffre initial pour le second code.

Cependant qu'est ce que tu entend par préidentifiable ?

Si on sait où trouver la partie commune, cela évite de la chercher !

En attendant ta réponse, après recherche dans VBA pour vérifier qu'il n'y avait pas de fonction dans le genre, j'ai commencé à construire une fonction visant à extraire la partie commune la plus longue entre deux chaînes, ce qui de toutes façons pourra toujours servir ailleurs...

On va voir ton problème... A+

Re,

Voilà une méthode :

Sub SommeCode()
    Dim d As Object, TS(), S, cde$, n%, i%
    Set d = CreateObject("Scripting.Dictionary")
    With ActiveSheet
        n = .Range("J1").End(xlDown).Row
        For i = 1 To n
            cde = Mid(.Cells(i, 10), 2, 5)
            If d.exists(cde) Then
                S = Val(d(cde)) + .Cells(i, 11)
                d(cde) = S
            Else
                d(cde) = .Cells(i, 11)
            End If
        Next i
        n = .Range("A" & .Rows.Count).End(xlUp).Row
        ReDim TS(2 To n, 1 To 1)
        For i = 2 To n
            cde = Right(.Cells(i, 1), 5)
            If d.exists(cde) Then TS(i, 1) = Val(d(cde))
        Next i
        .Range("B2").Resize(n - 1).Value = TS
    End With
End Sub

Cordialement.

Dans la foulée, je livre aussi une fonction renvoyant la partie commune la plus longue entre deux chaînes (supérieure à un caractère). C'est toi qui m'a involontairement branché là-dessus.

Function TxtCommunMax(txt1 As String, txt2 As String) As String
    Dim Tc(), tx(1) As String, pc$, i%, j%, n%
    If Len(Trim(txt1)) < Len(Trim(txt2)) Then
        tx(0) = Trim(txt1): tx(1) = Trim(txt2)
    Else
        tx(0) = Trim(txt2): tx(1) = Trim(txt1)
    End If
    ReDim Tc(1, 0): Tc(0, 0) = 0: Tc(1, 0) = 0
    For i = 1 To Len(tx(0))
        If InStr(tx(1), Mid(tx(0), i, 1)) Then
            For j = 1 To Len(tx(0)) - i
                If InStr(tx(1), Mid(tx(0), i, j + 1)) Then
                    pc = Mid(tx(0), i, j + 1)
                Else
                    Exit For
                End If
            Next j
            If j > 1 Then
                n = n + 1: ReDim Preserve Tc(1, n)
                Tc(0, n) = j: Tc(1, n) = pc
                If j > Tc(1, 0) Then
                    Tc(1, 0) = j: Tc(0, 0) = n
                End If
            End If
            i = i + j - 1
        End If
    Next i
    n = Tc(0, 0)
    TxtCommunMax = IIf(n > 0, Tc(1, n), "")
End Function

Elle semble fonctionner ! (et du premier coup !!)

Elle sera à adapter pour utilisation en feuille de calcul, et à améliorer pour comparaison ne tenant pas compte de la casse, ou éventuellement renvoyer toutes les chaînes communes, s'il y en a plusieurs...). Elles sont extraites par la fonction mais elle ne renvoie que la plus longue, ou la première trouvée plus longue si mêmes longueurs...

Cordialement.

Bonjour MFerrand,

Merci pour ta réponse, ça fonctionne parfaitement !

J'ai cependant vu un petit point qui pourrait poser problème :

Par exemple pour le premier code, ici on récupère la partie finale du code située après le tiret, donc à partir du cinquième caractère (Par exemple RN1-ABC01, on récupère ABC01), si jamais on à un code avec un caractère en plus (Par exemple RN10-DEF01), on récupère donc "-DEF01".

Je n'ai pas ce problème mais c'est quelque chose que j'ai détecté qui pourrait toujours arriver.

Merci pour la deuxième fonction, heureux que je t'ai branché la dessus ^^. En tout cas c'est quelque chose que je garde, ça peut toujours être intéressant à utiliser !!

Bonsoir,

Ce cas là n'arrivera pas, sur le 1er code, la macro récupère en partant de la fin :

cde = Right(.Cells(i, 1), 5)

Mais inventorie toutes les configurations des 2 codes, si tu veux être sûr qu'on répond à tous les cas.

Cordialement.