Comparaison et Extraction Morceau de Chaine de caractères.

[azerty123]

Bonjour,

Après une semaine d'assimilation de VBA et Excel, ainsi que deux jours perdu sur mon récent problème, je viens à vour pour mener à bien mon projet, en esseyant d'etre le plus clair possible.

Donc, je dispose d'une liste d'information de ce type (confidentiel, donc je met n'importe quoi) :

AB_CVDGFH_AEJ = '&Alelu Bla';

AB_CVDGFH_AEJ correspond à l'identifiant.
& signifie que la lettre suivant sera le raccourcis de cet identifiant.
Alelu Bla' correspond au libélé, afficher sur le logiciel.

Afin de ne pas vous endormir, j'en viens directement à mon problème :

Je dois travailler sur différente langues, l'identifiant est invariant, mais le libélé varie.

Colonne A, j'ai donc une série de AB_CVDGFH_AEJ = '&Alelu Bla';.
Colonne B, j'ai une longue liste d'identifiant, classé en groupe.

Je cherche, grace à une macro, que Excel m'affiche dans une colonne C, le libélé (qui lui change en fonction de la langue) à droite de l'identifiant qui lui correspond, ainsi que le raccourcis. Petit exemple :

A

AA_BLABLIBLOU_EF = '&bonjour';
AA_BLABLI_EG = '&hello';
BB_BLABLA_AA = '"welcome';
AA_BLABLOU_AA = '&salut';


B

AA_BLABLIBLOU_EF
AA_BLABLOU_AA
BB_BLABLA_AA
(cellule vide)
AA_BLABLi_AA


(donc colonne B pas du tout dans le même ordre que la colonne A)
Et je voudrais qu'automatiquement, dans la colonne C, j'ai :

&bonjour
&salut
&welcome
(cellule vide)
&hello

(en face du bon identifiant donc).

EDIT : le "&" correspond au raccourcis du mot auquel il est attaché, mais peut varier. Ex: pour &Hello, c'est H le raccourcis, mais on aurait très bien pu avoir Hell&o, à savoir o comme raccourcis. Pas d'impact sur le resulat recherché je pense, mais je le précise !

Ceci pour plusieurs miliers d'identifiants. Une sorte de grand tri en fait.




J'ai réussi à importer la colonne A grâce à

Dim Repertoire As String, Fichier As String
Dim strFullName As Variant
Dim Cn As Object, Rs As Object

'Sélection du ficher
strFullName = Application.GetOpenFilename("Fichiers textes (*.txt),*.txt", , "D:\Test\uStrs.txt")

'On sort si aucun fichier n'est sélectionné
If strFullName = False Then Exit Sub

Application.ScreenUpdating = False
Fichier = Dir(strFullName)
Repertoire = Left(strFullName, Len(strFullName) - (Len(Fichier) + 1))


'Connection
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & ";" & _
    "Extended Properties=""text;HDR=Yes;FMT=Delimited"""

'Requete
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open "SELECT * FROM [" & Fichier & "]", Cn, 3, 1, 1

'Boucle sur le résultat de la requete
While Not Rs.EOF
    'Ecriture des données dans la feuille
    '65536 spécifie le nombre de lignes par feuille
    ActiveSheet.Range("A7").CopyFromRecordset Rs, 65536
Wend

Rs.Close
Set Rs = Nothing
Cn.Close
Set Cn = Nothing
Application.ScreenUpdating = True

End Sub

Ou par exemple retirer les , . ect. de la fin de mes lignes avec

Dim i
For i = 1 To 1000
If Right(Range("A" & i), 1) = "'" Then Range("A" & i) = Left(Range("A" & i), Len(Range("A" & i)) - 1)
Next

Mais impossible de faire la comparaison d'une chaine par rapport au bout d'une autre chaine, et d'en sortir encore une autre chaine dans une colonne, en face de la colonne corespondante, que ce soit avec des InStr, Like et autre.




Merci d'avance pour votre aide.

 

[frangy]

Re : Comparaison et Extraction Morceau de Chaine de caractères.

Bonjour,

Voici un exemple de code qui réalise le traitement que tu souhaites.
Le caractère "=" est utilisé pour séparer l'identifiant et le libellé. Pour cela, on utilise la fonction SPLIT.
Ensuite, on fait du ménage : suppression des espaces et des caractères non désirés.
Puis on passe en revue chaque identifiant et on recherche une correspondance dans la colonne B.
Si on la trouve, on copie le libellé associé dans la colonne C.
Option Explicit

Sub Test()
Dim DerLigne As Long, i As Long
Dim j As Integer
Dim Tablo
Dim C As Range
Dim firstAddress As String
    With Worksheets("Feuil1")
        DerLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To DerLigne
            Tablo = Split(.Range("A" & i), "=")
            Tablo(0) = Trim(Tablo(0))
            Tablo(1) = Trim(Replace(Tablo(1), "'", ""))
            With .Range("B2:B" & .Range("B" & .Rows.Count).End(xlUp).Row)
                Set C = .Find(Tablo(0), LookIn:=xlValues)
                If Not C Is Nothing Then
                    firstAddress = C.Address
                    Do
                        C.Offset(0, 1) = Tablo(1)
                        Set C = .FindNext(C)
                    Loop While Not C Is Nothing And C.Address <> firstAddress
                End If
            End With
        Next i
    End With
End Sub

Cordialement.

 

[azerty123]

Re : Comparaison et Extraction Morceau de Chaine de caractères.

Bonjour,

Un grand merci pour cette précieuse aide.

J'aurais cependant une question. Votre .xls marche parfaitement. Cependant, dés que je lui demande de traité beaucoup d'informations, à savoir quelques centaines d'indentifiants / libélés, soit il ne fait rien, soit il m'indique "erreur d'éxécution 9 : l'indice n'appartient pas à la séléction" pour la ligne "Tablo(0) = Trim(Tablo(0))".

Je suppose, d'après l'aide Excel qu'il faut simplement définir pour le tableau un nombre de cellules à traité ? Suis je sur la bonne voie ?

J'ai aussi pensé au fait qu'il y a de temps en temps des cellules vides ou ne correspondant pas au format identifiant / libélé dans ma colonne A, est ce que cela influe ? Ma macro afin de faire le tri n'est pas tout à fait au top !

Et par conséquent, comment opéré si mon document qui contient aujourd'hui 300 identifiants est amené à devoir en traiter 500 dans un mois ?

Merci d'avance et bonne journéee.

 

[frangy]

Re : Comparaison et Extraction Morceau de Chaine de caractères.

Bonjour,

J'ai aussi pensé au fait qu'il y a de temps en temps des cellules vides ou ne correspondant pas au format identifiant / libélé dans ma colonne A, est ce que cela influe ?

C'est là que le bât blesse.
J’ai rajouté un test pour vérifier que le texte contient "=".

Option Explicit
Sub Test()
Dim DerLigne As Long, i As Long
Dim j As Integer
Dim Tablo
Dim C As Range
Dim firstAddress As String
    With Worksheets("Feuil1")
        DerLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To DerLigne
            If InStr(.Range("A" & i), "=") > 0 Then
                Tablo = Split(.Range("A" & i), "=")
                Tablo(0) = Trim(Tablo(0))
                Tablo(1) = Trim(Replace(Tablo(1), "'", ""))
                With .Range("B2:B" & .Range("B" & .Rows.Count).End(xlUp).Row)
                    Set C = .Find(Tablo(0), LookIn:=xlValues)
                    If Not C Is Nothing Then
                        firstAddress = C.Address
                        Do
                            C.Offset(0, 1) = Tablo(1)
                            Set C = .FindNext(C)
                        Loop While Not C Is Nothing And C.Address <> firstAddress
                    End If
                End With
            End If
        Next i
    End With
End Sub

Cordialement.

 

[azerty123]

Re : Comparaison et Extraction Morceau de Chaine de caractères.

Merci Frangy pour ton efficacité et ta disponibilité,

Bonne continuation,

Cordialement.