Copier une colonne,la déplacer avec des caractères en moins VBA Résolu/Fermé

Question

Bonjour, Je vous expose mon problème. J'ai un fichier excel ou sur une colonne bien précise (la colonne D), les cellules sont remplies de signes tels que : ">" et "<". La suppression de ce caractère et des chaines de caractères comprisent entre eux a été résolu dans un précédent poste : http://www.commentcamarche.net/forum/affich-27623359-supprimer-une-chaine-de-caracteres-compris-entre-deux-symboles ------- Maintenant, mon souci est que je n'arrive pas à exécuter le programme sur toute la colonne D et que cela soit redirigé vers une colonne créé E. Il faudra si possible supprimer l'ancienne colonne D pour que E devienne D. Si quelqu'un peut m'aider ? Je vous montre mon ébauche : ----Sub changement() --------Dim chaine, chaine2 As String --------Dim i As Integer --------i = 1 --------Do ------------chaine = Range("E" & i) ------------Columns("F:F").Insert Shift:=xlToRight ------------If InStr(chaine, "<") = 0 Then ----------------MsgBox ("Plus rien à supprimer !") ----------------Exit Sub ------------End If ------------If Left(chaine, 1) = "<" Then ----------------chaine = Right(chaine, Len(chaine) - InStr(chaine, ">")) ------------End If ------------If InStr(chaine, "<") <> 0 Then ----------------chaine2 = Range("F" & i) ----------------chaine2 = chaine2 & Left(chaine, InStr(chaine, "<") - 1) ----------------chaine = Right(chaine, Len(chaine) - InStr(chaine, "<") + 1) ----------------Range("E" & i) = chaine ----------------Range("F" & i) = chaine2 ------------Else ----------------chaine2 = Range("F" & i) ----------------chaine2 = chaine2 & chaine ----------------Range("E" & i) = chaine ----------------Range("F" & i) = chaine2 ------------End If ------------i = i + 1 ----Loop While Cells.Activate = "" ----End Sub Mon programme ne fait que l'insertion de la colonne et ne copie plus sur celle-ci. Cordialement, Greg le novice

Greg le novice · Answer

J'ai réussi finalement à faire mon code tout seul. Je le mets à disposition si cela peut servir pour certains : Je redis à quoi il sert : Le programme va demander quelle colonne l'on veut rectifier. J'entends par rectifier qu'il va supprimer tout les caractères compris entre des "<" et ">". Il va copier les cellules une part une dans une nouvelle colonne, supprimer ensuite la colonne avec les caractères ">" et "<" pour mettre la colonne rajouté à cette place. Et affichera un message disant que toute la colonne a été rectifié. Sub rectifier() Dim chaine, chaine2 As String Dim i As Integer Dim lettre As String Dim lettre2 As String lettre = InputBox("Quelle colonne voulez-vous rectifier ?") If lettre = "A" Then lettre2 = "B" End If If lettre = "B" Then lettre2 = "C" End If If lettre = "C" Then lettre2 = "D" End If If lettre = "D" Then lettre2 = "E" End If If lettre = "E" Then lettre2 = "F" End If If lettre = "F" Then lettre2 = "G" End If If lettre = "G" Then lettre2 = "H" End If If lettre = "H" Then lettre2 = "I" End If If lettre = "I" Then lettre2 = "J" End If If lettre = "J" Then lettre2 = "K" End If If lettre = "K" Then lettre2 = "L" End If If lettre = "L" Then lettre2 = "M" End If If lettre = "M" Then lettre2 = "N" End If If lettre = "N" Then lettre2 = "O" End If If lettre = "O" Then lettre2 = "P" End If If lettre = "P" Then lettre2 = "Q" End If If lettre = "Q" Then lettre2 = "R" End If If lettre = "R" Then lettre2 = "S" End If If lettre = "S" Then lettre2 = "T" End If If lettre = "T" Then lettre2 = "W" End If If lettre = "W" Then lettre2 = "X" End If If lettre = "X" Then lettre2 = "Y" End If If lettre = "Y" Then lettre2 = "Z" End If If lettre = "Z" Then lettre2 = "AA" End If Dim dernier_caractere As String Dim j As Integer i = 1 j = 1 Columns(lettre2 & ":" & lettre2).Insert Shift:=xlToRight While j <> 10 If Range(lettre & i).Value = "" Then j = j + 1 End If chaine = Range(lettre & i) dernier_caractere = Right(chaine, 1) If dernier_caractere <> ">" And Range(lettre & i).Value <> "" Then Range(lettre & i).Value = Range(lettre & i).Value & "<>" End If chaine = Range(lettre & i) If InStr(chaine, "<") = 0 And j = 10 Then MsgBox ("Tout est corrigé!") Columns(lettre).Select Selection.Delete Shift:=xlToLeft Exit Sub End If Do If Left(chaine, 1) = "<" Then chaine = Right(chaine, Len(chaine) - InStr(chaine, ">")) End If If InStr(chaine, "<") <> 0 Then chaine2 = Range(lettre2 & i) chaine2 = chaine2 & Left(chaine, InStr(chaine, "<") - 1) chaine = Right(chaine, Len(chaine) - InStr(chaine, "<") + 1) Range(lettre & i) = chaine Range(lettre2 & i) = chaine2 Else chaine2 = Range(lettre2 & i) chaine2 = chaine2 & chaine Range(lettre & i) = chaine Range(lettre2 & i) = chaine2 End If Loop While Left(chaine, 1) = "<" i = i + 1 Wend End Sub Cordialement, Greg le novice

Copier une colonne,la déplacer avec des caractères en moins VBA

1 réponse

Discussions similaires