Probleme de copiage de chaine de caractere en vba
Résolu
Cedric_hess
Messages postés
30
Statut
Membre
-
pijaku Messages postés 13513 Date d'inscription Statut Modérateur Dernière intervention -
pijaku Messages postés 13513 Date d'inscription Statut Modérateur Dernière intervention -
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;
Merci a vous !
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 !
1 réponse
-
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 devientSepar = 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
