Probleme de copiage de chaine de caractere en vba

Résolu/Fermé

Cedric_hess Messages postés 28 Date d'inscription mercredi 30 mars 2016 Statut Membre Dernière intervention 24 mai 2016 - Modifié par pijaku le 30/03/2016 à 12:42
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 30 mars 2016 à 13:05

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 !

A voir également:

Probleme de copiage de chaine de caractere en vba
Caractère ascii - Guide
Caractere speciaux - Guide
Caractère spéciaux - Guide
Caractère spéciaux mac clavier - Guide
Plus de chaine tv - Guide

1 réponse

Réponse 1 / 1

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
30 mars 2016 à 12:42

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

Cedric_hess Messages postés 28 Date d'inscription mercredi 30 mars 2016 Statut Membre Dernière intervention 24 mai 2016
30 mars 2016 à 13:04

Merci beaucoup pijaku ca marche parfaitement , vraiment j'ai pas pense a ca , merci encore

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744 > Cedric_hess Messages postés 28 Date d'inscription mercredi 30 mars 2016 Statut Membre Dernière intervention 24 mai 2016
30 mars 2016 à 13:05

De rien.
A+

Discussions similaires

Caractère invisible ou vide pour pseudo invisible

Erreur d'exécution 13 Incompatibilité de type

Dessiner avec son clavier et avec des lettres

Excel : extraire le texte après un caractère

Comment insérer correctement des caractères spéciaux ou émojis ?

Discussions similaires

Newsletters