Identifier packs entre séparateurs, trier, tronquer

Bonjour à tous,

Je reviens encore vous, la communauté, avec un besoin pas possible.

En exemple, le fichier joint.

L'agencement des chaines entre séparateurs est imprévisible.

Seulement des années apparaissent après chaque séparateur |, toujours en 1ère position.

Seulement c'est bien les 2 lettres indicatifs qui suivent ces 4 caractères que je veux garder, et je ne veux en garder qu'un seul, celui de l'année la plus ancienne

J'aimerais pouvoir trier ces packs entre séparateurs par année, cibler les 2 caractères lettres après l'année, et ne garder que eux.

Je mets en support le travail de : Steelson et Jean-Eric.

Ceci permet de cibler le 1er block entre chaque séparateur. J'aurais bien adapté la fonction cleantext pour cibler les 2 caractères qui suivent les 4 premiers, mais il faut les ranger du plus petit au plus grand d'abord...

En fait j'aimerais pouvoir cibler/identifier/nettoyer n'importe qu'elle caractère dans une chaine dans une cellule contenant plusieurs chaines entre séparateurs.

Steelson

Public Function CleanText(sText As String) As String
    Dim tbl1 As Variant, tbl2 As Variant, i As Long, x As String
        tbl1 = Split(Trim(sText), "|")
        x = ""
        For i = 0 To UBound(tbl1)
            tbl2 = Split(Trim(tbl1(i)), " ")
            x = x & tbl2(UBound(tbl2)) & ";"
        Next i
        CleanText = Replace(Replace(x, "[", ""), "]", "")
    End Function

Jean-Eric

Option Explicit

Public Function CleanText(sText As String) As String
Dim tbl, tbl2
Dim I As Long
Dim x As String

    CleanText = ""
    tbl = Split(Trim(sText), "|")
    If UBound(tbl) > 0 Then
        For I = 0 To UBound(tbl) - 1
            tbl2 = Split(tbl(I), " ")
            x = x & tbl2(0) & ";"
        Next I
    End If

    CleanText = x

End Function

Et le final ajusté par mes soins

Sub nettoie()
 Dim i As Long

    For i = 2 To Sheets(1).Range("C" & Rows.Count).End(xlUp).Row
    Sheets(1).Cells(i, 4).Value = CleanText(Sheets(1).Cells(i, 3))
    Next i

 End Sub

Public Function CleanText(sText As String) As String
    Dim tbl1 As Variant, tbl2 As Variant, i As Long, x As String
        tbl1 = Split(Trim(sText), "|")
        x = ""
        For i = 0 To UBound(tbl1)
            tbl2 = Split(Trim(tbl1(i)), " ")
            x = x & tbl2(UBound(tbl2)) & ";"
        Next i
        CleanText = Replace(Replace(x, "[", ""), "]", "")
    End Function

Public Function fonctionPerso(ByVal chaine As String) As String
Dim reg As VBScript_RegExp_55.RegExp
Dim Match As VBScript_RegExp_55.Match
Dim Matches As VBScript_RegExp_55.MatchCollection
Dim min As Integer
Dim lettre As String
min = 9999

' instanciation
Set reg = New VBScript_RegExp_55.RegExp

'reg.Pattern = "(\w)(a)"
reg.Pattern = "(\|)(\d{4})([A-Z]{2})"
reg.Global = True
Set Matches = reg.Execute(chaine)
For Each Match In Matches
    Debug.Print Match.Value
    If Match.SubMatches(1) < min Then
        min = Match.SubMatches(1)
        lettre = Match.SubMatches(2)
    End If
Next Match

fonctionPerso = lettre

End Function

Ci-joint le fichier déjà utilisable

Merci d3d9x.

Je propose aussi une solution, qui se fait en 3 temps mais pas forcément la plus complexe :

Temps 1 : J'applique la fonction Cleantext

Sub nettoie()
 Dim i As Long
    For i = 2 To Sheets(2).Range("B" & Rows.Count).End(xlUp).Row
    Sheets(2).Cells(i, 3).Value = CleanText(Sheets(2).Cells(i, 2))
    Next i

 End Sub

Public Function CleanText(sText As String) As String
    Dim tbl1 As Variant, tbl2 As Variant, i As Long, x As String
        tbl1 = Split(Trim(sText), "-")
        x = ""
        For i = 0 To UBound(tbl1)
            tbl2 = Split(Trim(tbl1(i)), " ")
            x = x & tbl2(UBound(tbl2)) & ";"
        Next i
        CleanText = Replace(Replace(x, "[", ""), "]", "")
    End Function

Temps 2 : Je découpe les blocks pour ne garder que l'année + l'indication pour chaque blocks; je la rédige dans la cellule juxtaposée à droite.

Sub numero_matricule_publication2()
i = 2
Dim stock As String
While Sheets(2).Cells(i, 2) <> Empty
stock = Trim(Split(Sheets(2).Cells(i, 3), ";")(0))
Sheets(2).Cells(i, 4) = stock
i = i + 1
Wend
End Sub

Temps 3 : J'isole l'élément tout à gauche, avec l'équivalent d'une gauche classique, avec la fonction Mid(chaine,début,taille); je rédige le résultat à la place de la toute première donnée. Je supprime les 2 colonnes crées.

Sub isoler_indicatif()
Dim k As Integer
Dim i As Long
    i = 2
        Dim monTexte4 As String
            For i = 2 To Sheets(2).Range("B" & Rows.Count).End(xlUp).Row
                monTexte4 = Mid(Feuil2.Cells(i, 3), 5, 2)
                Sheets(2).Cells(i, 2).Value = monTexte4
            Next
    Columns("D:C").Delete Shift:=xlToLeft
End Sub

Je test ta solution,

G.

Ma solution utilise les expressions régulières et est pour le coup carrément plus propre ^^

Je cherche tout ce qui peut être mis sous la forme

|ccccLL

où:

| = |

c= un chiffre entre 0 et 9

L : une lettre majuscule

Pour toutes les correspondances, je teste la date, si la date est inférieure à la date min, je récupère les deux lettres.

Oui, c'est surement plus sophistiqué que mes bidouillages ^^

Encore merci,

G.