Probleme de copiage de chaine de caractere en vba Résolu

Question

Bonjour tout le monde , 

j'ai un code VBA qui fait la comparaison entre 4 colonnes et qui stock les resultats dans autres 3 colonnes , le code marche parfaitement quand j'ai fait des tset mais j'ai pas fait attention aux espaces alors maintenant quand le code stock les resultat qui sont des chaines de caracteres il copie pas tout le contenu de la cellule il copie jusqu'au premier espace et il s'arrete . 

par exemple : si la chaine a copier est ''Air Approval always needed'' dans le resultat je trouve que ''Air'' est ce que il y a une solution pourque le code me copie la chaine entiere ? voici le code et le ficheir excel sur lequel je travail 

voila le fichier excel : https://www.cjoint.com/c/FCEhZSO3Bev 

et voila le code;

Sub comparer()
Dim Derlig As Long, Lig As Long, Ref As String
Dim T_ab, D_ab As Object, T_cd, D_cd As Object
Dim T_fgh, Cptr As Long, Separ
Dim start As Single
'--------------------initialisations
    start = Timer
    Application.ScreenUpdating = False
    'nettoyage
    Range("E2:G30000").Clear
    'concaténation colonnes A & B
    Set D_ab = CreateObject("scripting.dictionary")
     Derlig = Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
    T_ab = Range("A2:B" & Derlig)
    For Lig = 1 To UBound(T_ab)
        Ref = T_ab(Lig, 1) & " " & T_ab(Lig, 2)
        If Not D_ab.exists(Ref) Then D_ab.Add Ref, ""
    Next
    T_ab = D_ab.keys
    'concaténation colonnes C & D
    Set D_cd = CreateObject("scripting.dictionary")
     Derlig = Columns("C").Find(what:="*", searchdirection:=xlPrevious).Row
    T_cd = Range("C2:D" & Derlig)
    For Lig = 1 To UBound(T_cd)
        Ref = T_cd(Lig, 1) & " " & T_cd(Lig, 2)
        If Not D_cd.exists(Ref) Then D_cd.Add Ref, ""
    Next
    T_cd = D_cd.keys
    
'- -----------------comparaisons
    ReDim T_fgh(3, 0) 'preparation tablo comparé
' DELETED_fonctionnalités
    For Lig = 0 To UBound(T_ab)
        If Not D_cd.exists(T_ab(Lig)) Then
            Separ = Split(T_ab(Lig))
            ReDim Preserve T_fgh(3, Cptr)
            T_fgh(0, Cptr) = Separ(0)
            T_fgh(1, Cptr) = Separ(1)
          Cptr = Cptr + 1
        End If
    Next
'NEW_fonctionnalités
    For Lig = 0 To UBound(T_cd)
        If Not D_ab.exists(T_cd(Lig)) Then
            Separ = Split(T_cd(Lig))
            ReDim Preserve T_fgh(3, Cptr)
            T_fgh(0, Cptr) = Separ(0)
            T_fgh(2, Cptr) = Separ(1)
          Cptr = Cptr + 1
        End If
    Next
'------------------restitution
    Range("F2").Resize(Cptr, 3) = Application.Transpose(T_fgh)
    Derlig = Range("E2:H100000").Find(what:="*", searchdirection:=xlPrevious).Row
    Range("F2:H" & Derlig).Borders.Weight = xlThin
    
    Application.ScreenUpdating = True
    MsgBox "comparaison efffectuée en " & Timer - start & " secondes"
    
End Sub

Merci a vous !

pijaku · Answer

Bonjour,

est ce que il y a une solution pourque le code me copie la chaine entiere ?
Le code "copie" bien la chaine entière. Le problème est ta façon de le concaténer puis de le splitter.
Si tu utilisais un caractère spécial comme séparateur de la concaténation, tu pourrais ensuite "splitter" ta chaîne en fonction de ce caractère, et pas en fonction des espaces.

Dans le code corrigé ci-dessous, j'utilises ¤ pour concaténer (au lieu de ton " ") Ref = T_ab(Lig, 1) & "¤" & T_ab(Lig, 2). Comme ça, le split devient Separ = Split(T_ab(Lig), "¤") et il me sépare la chaine comme il convient.

Option Explicit

Sub comparer()
Dim Derlig As Long, Lig As Long, Ref As String
Dim T_ab, D_ab As Object, T_cd, D_cd As Object
Dim T_fgh, Cptr As Long, Separ
Dim start As Single
'--------------------initialisations
    start = Timer
    Application.ScreenUpdating = False
    'nettoyage
    Range("E2:G30000").Clear
    'concaténation colonnes A & B
    Set D_ab = CreateObject("scripting.dictionary")
     Derlig = Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
    T_ab = Range("A2:B" & Derlig)
    For Lig = 1 To UBound(T_ab)
        Ref = T_ab(Lig, 1) & "¤" & T_ab(Lig, 2)
        If Not D_ab.exists(Ref) Then D_ab.Add Ref, ""
    Next
    T_ab = D_ab.keys
    'concaténation colonnes C & D
    Set D_cd = CreateObject("scripting.dictionary")
     Derlig = Columns("C").Find(what:="*", searchdirection:=xlPrevious).Row
    T_cd = Range("C2:D" & Derlig)
    For Lig = 1 To UBound(T_cd)
        Ref = T_cd(Lig, 1) & "¤" & T_cd(Lig, 2)
        If Not D_cd.exists(Ref) Then D_cd.Add Ref, ""
    Next
    T_cd = D_cd.keys
    
'- -----------------comparaisons
    ReDim T_fgh(3, 0) 'preparation tablo comparé
' fonctionalités suppprimés
    For Lig = 0 To UBound(T_ab)
        If Not D_cd.exists(T_ab(Lig)) Then
            Separ = Split(T_ab(Lig), "¤")
            ReDim Preserve T_fgh(3, Cptr)
            T_fgh(0, Cptr) = Separ(0)
            T_fgh(1, Cptr) = Separ(1)
          Cptr = Cptr + 1
        End If
    Next
'nouvelles fonctionalités
    For Lig = 0 To UBound(T_cd)
        If Not D_ab.exists(T_cd(Lig)) Then
            Separ = Split(T_cd(Lig), "¤")
            ReDim Preserve T_fgh(3, Cptr)
            T_fgh(0, Cptr) = Separ(0)
            T_fgh(2, Cptr) = Separ(1)
          Cptr = Cptr + 1
        End If
    Next
'------------------restitution
    Range("F2").Resize(Cptr, 3) = Application.Transpose(T_fgh)
    Derlig = Range("E2:H100000").Find(what:="*", searchdirection:=xlPrevious).Row
    Range("F2:H" & Derlig).Borders.Weight = xlThin
    
    Application.ScreenUpdating = True
    MsgBox "comparaison efffectuée en " & Timer - start & " secondes"
    
End Sub

Probleme de copiage de chaine de caractere en vba

1 réponse

Votre réponse

Discussions similaires

Newsletters