Déplacement d'une partie de texte sous condition

Bonjour à toutes et tous,

Les jours avancent et les problèmes excel ne se ressemblent pas!

Aujourd'hui, voici mon problème : j'ai dans chaque cellule d'un fichier une valeur ( à 2 ou 3 chiffres uniquement) entourée par du texte (par exemple"<attribut_id_107>120</attribut_id_107>"), et ce que je souhaiterais c'est que si deux cellules consécutives ont le même attribut, alors les deux valeurs présentes dans chacune des cellules se retrouvent dans la première où l'attribut est présent, séparées par une virgule et que la cellule suivante soit supprimée.

Dans mon cas présent je sais que seuls les attributs 107 peuvent se trouver dans cette configuration.

Dans l'idée j'ai décidé d'utiliser les fonctions Mid, Len Right et Left, et j'étais plutôt fier de moi jusqu'à ce que je me rende compte que... la façon dont je l'ai écrit ne donne rien...

Voici donc le code et un extrait de fichier avec un exemple plus parlant :

For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
    For j = 1 To 10
        If Cells(i, j).Value Like "*107*" And Cells(i, j + 1).Value Like "*107*" Then
            If Len(Cells(i, j)) = 36 Then
                If Len(Cells(i, j + 1)) = 36 Then
                    Cells(i, j).Value = Left(Cells(i, j), 19) & "," & Mid(Cells(i, j + 1), 18, 2) & Right(Cells(i, j), 17) And Cells(i, j + 1).ClearContents 'ou delete c'est égal'
                Else: Cells(i, j).Value = Left(Cells(i, j), 19) & "," & Mid(Cells(i, j + 1), 18, 3) & Right(Cells(i, j), 17) And Cells(i, j + 1).ClearContents
                End If
            End If
            If Len(Cells(i, j)) = 37 Then
                If Len(Cells(i, j + 1)) = 36 Then
                    Cells(i, j).Value = Left(Cells(i, j), 20) & "," & Mid(Cells(i, j + 1), 18, 2) & Right(Cells(i, j), 17) And Cells(i, j + 1).ClearContents
                Else: Cells(i, j).Value = Left(Cells(i, j), 20) & "," & Mid(Cells(i, j + 1), 18, 3) & Right(Cells(i, j), 17) And Cells(i, j + 1).ClearContents
                End If
            End If
        Else: Cells(i, j).Value = Cells(i, j).Value
        End If
    Next j
Next i

Bon si quelqu'un peut me pointer du doigt ma grosse erreur, ce serait vraiment sympa!

Merci à tous et toutes pour votre temps!

Salut Scarwild,

voici ton code.

Attention, pour faire simple, j'ai utilisé 'CurrentRegion' en [A1] pour alimenter tData. Je ne sais pas si cela conviendra à ta situation réelle!

A adapter, peut-être...

La macro démarre sur un simple double-clic.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData
'
tData = Range("A1").CurrentRegion.Value
'
For x = 1 To UBound(tData, 1)
    For y = 1 To UBound(tData, 2) - 1
        If tData(x, y) <> "" And tData(x, y + 1) <> "" Then _
            If Split(Split(tData(x, y), ">")(0), "_")(2) = Split(Split(tData(x, y + 1), ">")(0), "_")(2) Then _
                tData(x, y) = Split(tData(x, y), "</")(0) & "," & Split(tData(x, y + 1), ">")(1): _
                tData(x, y + 1) = ""
    Next
Next
Range("A1").Resize(UBound(tData, 1), UBound(tData, 2)).Value = tData
'
End Sub

A+

Wahou...

Alors là je suis vraiment impréssionné... Je reste sans voix...

Y a pas à dire, quand on ne sait, pas, on ne sait pas.

Merci infiniment curilis57 : c'est un million de fois plus beau que mes bricolages, et en plus cela fonctionne au-delà de mes espérances!

Maintenant, un peu de travail pour comprendre ce qu'il s'est passé et pouvoir l'appliquer plus tard si besoin.

Encore merci et à une prochaine fois sans doute!