Supprimé de façon automatisé du texte
ouaip j'ai vu ça du coup, normalement ça va en continu, à voir dans l'avenir !
j'ai une question, vous travaillez pour Excel ou vous étes simplement des gens qui touche leur bille en informatique ?
Alice51 a écrit :j'ai une question, vous travaillez pour Excel ou vous étes simplement des gens qui touche leur bille en informatique ?
Excellent ...!!!
Nous travaillons tous pour EXCEL ...!!!
Dac James lol.
Sur la macro j'ai remarqué que je ne peux pas faire de retour en arrière avec la flèche en haut à gauche après avoir fait un copier coller. Est-ce normal?
Bonjour Alice, Theze,
Bonjour le forum,
Pour l'enregistrement, Theze a fait le boulot! Merci à lui.
Améliorations à ton fichier :
- la macro calcule (et élimine le cas échéant) indépendamment la présence de / --GID-- / <DEC> / nombre aléatoire / avec ou sans retour ligne à leur suite ;
- placement d'une apostrophe en début de texte si celui-ci commence par un signe = ou - ou + pour éviter l'assimilation de ton texte à une formule en cas de modification.
iRow = Range("L" & Rows.Count).End(xlUp).Row
tData = Range("L2:L" & iRow).Value
For x = 1 To UBound(tData)
iCar = 0
If Len(tData(x, 1)) > 0 Then
'iCar = nombre de caractères à éliminer
'calcule la présence de --GID-- suivi ou non d'un retour ligne
If Left(tData(x, 1), 7) = "--GID--" Then iCar = IIf(Asc(Mid(tData(x, 1), 8, 1)) > 31, 7, 8)
'calcule la présence de <DEC> suivi ou non d'un retour ligne
If Mid(tData(x, 1), iCar + 1, 5) = "<DEC>" Then
iCar = IIf(Asc(Mid(tData(x, 1), iCar + 6, 1)) > 31, iCar + 5, iCar + 6)
End If
'calcule la présence du nombre aléatoire
If IsNumeric(Mid(tData(x, 1), iCar + 1, 8)) Then iCar = IIf(Asc(Mid(tData(x, 1), iCar + 9, 1)) > 31, iCar + 8, iCar + 9)
If iCar > 0 Then tData(x, 1) = Right(tData(x, 1), Len(tData(x, 1)) - iCar)
If Left(tData(x, 1), 1) = "=" Or Left(tData(x, 1), 1) = "-" Or Left(tData(x, 1), 1) = "+" Then tData(x, 1) = "'" & tData(x, 1)
End If
Next
Range("L2:L" & iRow).Value = tData
Range("L:L").WrapText = FalseJe place le code pour donner l'occasion aux cracks d'éventuellement me donner d'autres pistes plus intelligentes pour résoudre le problème.
Ben oui, je travaille toujours avec des bonnes vieilles méthodes de dinosaure...
A+
Je coup je remplace :
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim tData
'
If Target.Count > 1 Then
Application.EnableEvents = False
Application.ScreenUpdating = False
'
iRow = Range("W" & Rows.Count).End(xlUp).Row
tData = Range("W2:W" & iRow).Value
For x = 1 To UBound(tData)
iCar = 0
If Len(tData(x, 1)) > 1 Then
If Left(tData(x, 1), 7) = "--GID--" Then iCar = 8
If Mid(tData(x, 1), 9, 5) = "<DEC>" Then iCar = 14
If iCar > 0 Then tData(x, 1) = Right(tData(x, 1), Len(tData(x, 1)) - iCar)
End If
Next
Range("W2:W" & iRow).Value = tData
Range("W:W").WrapText = False
'
If [AAA1] > 0 Then
ActiveWindow.ScrollRow = [AAA1]
ActiveWindow.ScrollColumn = 1
[A1].Select
End If
'
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
'
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'
If Target.Count > 1 Then
[AAA1] = Selection.Row
Exit Sub
End If
'
Cancel = True
iRow = Range("W" & Rows.Count).End(xlUp).Row
'
If Not Intersect(Target, Range("W2:W" & iRow)) Is Nothing Then Target.WrapText = IIf(Target.WrapText = False, True, False)
'
End Sub
uniquement par le nouveau code suivant ?
iRow = Range("L" & Rows.Count).End(xlUp).Row
tData = Range("L2:L" & iRow).Value
For x = 1 To UBound(tData)
iCar = 0
If Len(tData(x, 1)) > 0 Then
'iCar = nombre de caractères à éliminer
'calcule la présence de --GID-- suivi ou non d'un retour ligne
If Left(tData(x, 1), 7) = "--GID--" Then iCar = IIf(Asc(Mid(tData(x, 1), 8, 1)) > 31, 7, 8)
'calcule la présence de <DEC> suivi ou non d'un retour ligne
If Mid(tData(x, 1), iCar + 1, 5) = "<DEC>" Then
iCar = IIf(Asc(Mid(tData(x, 1), iCar + 6, 1)) > 31, iCar + 5, iCar + 6)
End If
'calcule la présence du nombre aléatoire
If IsNumeric(Mid(tData(x, 1), iCar + 1, 8)) Then iCar = IIf(Asc(Mid(tData(x, 1), iCar + 9, 1)) > 31, iCar + 8, iCar + 9)
If iCar > 0 Then tData(x, 1) = Right(tData(x, 1), Len(tData(x, 1)) - iCar)
If Left(tData(x, 1), 1) = "=" Or Left(tData(x, 1), 1) = "-" Or Left(tData(x, 1), 1) = "+" Then tData(x, 1) = "'" & tData(x, 1)
End If
Next
Range("L2:L" & iRow).Value = tData
Range("L:L").WrapText = False
(en faisant attention car là la colonne est L et que moi c'est X bien entendu)
Salut Alice,
ah, non, hein!
C'est juste le code WorkSheet_Change!
WorkShet_BeforeRightClick est à conserver!
Relis bien les manoeuvres!
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim tData
'
If Target.Count > 1 Then
Application.EnableEvents = False
Application.ScreenUpdating = False
'
iRow = Range("L" & Rows.Count).End(xlUp).Row
tData = Range("L2:L" & iRow).Value
For x = 1 To UBound(tData)
iCar = 0
If Len(tData(x, 1)) > 0 Then
'iCar = nombre de caractères à éliminer
'calcule la présence de --GID-- suivi ou non d'un retour ligne
If Left(tData(x, 1), 7) = "--GID--" Then iCar = IIf(Asc(Mid(tData(x, 1), 8, 1)) > 31, 7, 8)
'calcule la présence de <DEC> suivi ou non d'un retour ligne
If Mid(tData(x, 1), iCar + 1, 5) = "<DEC>" Then iCar = IIf(Asc(Mid(tData(x, 1), iCar + 6, 1)) > 31, iCar + 5, iCar + 6)
'calcule la présence du nombre aléatoire
If IsNumeric(Mid(tData(x, 1), iCar + 1, 8)) Then iCar = IIf(Asc(Mid(tData(x, 1), iCar + 9, 1)) > 31, iCar + 8, iCar + 9)
If iCar > 0 Then tData(x, 1) = Right(tData(x, 1), Len(tData(x, 1)) - iCar)
If Left(tData(x, 1), 1) = "=" Or Left(tData(x, 1), 1) = "-" Or Left(tData(x, 1), 1) = "+" Then tData(x, 1) = "'" & tData(x, 1)
End If
Next
Range("L2:L" & iRow).Value = tData
Range("L:L").WrapText = False
'
If [AAA1] > 0 Then
ActiveWindow.ScrollRow = [AAA1]
ActiveWindow.ScrollColumn = 1
[A1].Select
End If
'
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
'
End SubPour annuler, il y a bien
Application.Undo
mais je n'ai jamais testé encore! Voilà l'occasion...
A+
iCar = IIf(Asc(Mid(tData(x, 1), iCar + 9, 1)) > 31, iCar + 8, iCar + 9)
Ce code là visiblement ne marche pas, il apparait en jaune dans les erreurs.
Salut Alice,
on parle bien de ...
[quote]If IsNumeric(Mid(tData(x, 1), iCar + 1, 8)) Then iCar = IIf(Asc(Mid(tData(x, 1), iCar + 9, 1)) > 31, iCar + 8, iCar + 9)[/quote]
Je viens de faire un copier-coller, pas de souci...
Envoie-moi ton fichier de travail, si possible...
A+
Oulalalalalalalalalalaa, je suis perdu mon ami,
Le code Worksheet / le Workshet_BeforeRightClick
Quoi donc c'est ces choses. Là vous m'avez perdu. C'est trop en une fois, je suis vraiment désolé, j'ai pas compris.
Il y a aussi une petite chose qui est un peu voir pas mal gênante que tu as codifier curu pour la sécurité. C'est de pas pouvoir faire un copier coller sur une seule case (autre que sur la colonne X composant les GID etc). S'il était possible de faire sauter ça peux étre ?
Je te remet le fichier de travail que j'utilise.
Bonjour Alice,
on peut tout faire (ou presque) en VBA.
C'est vrai que, souvent trop vite, j'essaie d'anticiper les besoins de l'utilisateur!
D'où, la nécessité de connaître les-dits besoins et/ou autres habitudes de travail.
Je postule (à toi de me dire ce qu'il en est en réalité) :
- que tu copies des lignes entières (effectivement, avec ce code, tu ne peux pas copier une seule cellule!)
- que chaque cellule, excepté en colonne A (je vois bien que d'autres colonnes aussi ne comportent que des info très courtes), est susceptible d'être potentiellement encodée en multi-lignes.
Donc, ici...
- tu peux ne copier qu'une ligne à la fois si tu le souhaites mais pas une seule cellule.
- un clic droit sur une cellule affiche son contenu en multi-lignes (du moins si le texte comporte des retour-ligne).
- deux boutons, en [A1], rouge et vert te permettent d'afficher tout le tableau en multi-lignes (vert) ou de les réduire (rouge).
On peut tout imaginer! A toi de préciser exactement ce que tu veux!
C'est toi qui travaille!
Nous, on joue aux billes!
A ton écoute!
A+
Bonjour à tous,
je n'ai pas compris la question tout à fait de la même façon, donc au cas où :
si une macro est lancée elle efface l'historique des actions faites, tu ne peux donc plus annuler une opération.
eric
Pourquoi vous utilisez toujours des mots compliqués lol. A la base tout était simple lollllllll (fin pour moi mdr).
je recommence au début. Ce qu'il me faut :
Colonne X : supprimer le --GID-- / <DEC> / et EVENTUELLEMENT (sans obligation du tout du tout du tout) le chiffre aléatoire.
Voilà. (lol)
Action qui sont faites au long des jours sur le document :
1/ Collage d'une ou plusieurs lignes en même temps venant d'un autre document.
2/ Copier coller d'une cellule à une autre (en dehors de la colonne X), exemple copier M4 et coller en M12 ou copier L13 et coller en M14.
3/ Écriture dans une cellule.
4/ TCD : Tableau Croisé Dynamique en relation avec les cellules.
Après c'est un peu près tout.
Je ne sais pas quoi dire de plus...
Salut Alice,
j'ai donc simplifié mon truc...
- tu peux copier une ou plusieurs lignes, une ou plusieurs cellules... ;
- un seul bouton en [A1] qui passe du rouge au vert pour un affichage global ou pas du multi-lignes ;
- un double-click sur une cellule active le multi-lignes pour une lecture/modification faciles (si pas de changement, le multi-lignes persiste)
Encore à améliorer sans doute selon tes indications...
A+
Parfait, je vais travailler avec tes codes voir ce que ça donner.
En tout ça je te remercie pour ton travail.
Je te donne des nouvelles après utilisation des codes.
J'ai ce message quand j'ouvre mon document, y a-t-il un soucie avec les différents tableaux dynamique ?
Bonjour Alice,
pas touché à tes TCD...
J'ai eu ce message moi-même en ouvrant ton fichier.
N'ayant jamais joué avec ces outils là, je ne me suis occupé que de ma partie.
A+
Bonjour,
la dernière colonne n'a pas de titre.
eric
Effectivement, j'ai pris note que le message d'erreur n'étais pas du à la macro.
Parcontre j'ai un petit problème. J'ai voulu rajouter une colonne sur mon tableau. Du coup ça décale la cible de la macro d'une colonne, soit sur la colonne Y. Du coup de la dernière macro de Curu, j'ai changer les X par des Y, maintenant plus rien de marche.
J'avais modifier la macro de Curu, et je suis arrivé à ça :
Private Sub cmdWrapOnOff_Click()
'
Application.ScreenUpdating = False
'
If Me.cmdWrapOnOff.BackColor = RGB(0, 180, 80) Then
UsedRange.WrapText = False
Me.cmdWrapOnOff.BackColor = RGB(255, 0, 0)
Else
UsedRange.WrapText = True
Me.cmdWrapOnOff.BackColor = RGB(0, 180, 80)
End If
iRow = UsedRange.Rows.Count
UsedRange.Rows("3:" & iRow).AutoFit
'
Application.ScreenUpdating = True
'
End Sub
Private Sub cmdWrapOn_Click()
'
Application.ScreenUpdating = False
'
UsedRange.WrapText = True
iRow = UsedRange.Rows.Count
UsedRange.Rows("3:" & iRow).AutoFit
'
Application.ScreenUpdating = True
'
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Target.WrapText = True
'
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim tData
'
If Target.Count > 1 Then
Application.EnableEvents = False
Application.ScreenUpdating = False
'
iRow = Range("Y" & Rows.Count).End(xlUp).Row
tData = Range("Y2:Y" & iRow).Value
For x = 1 To UBound(tData)
iCar = 0
If Len(tData(x, 1)) > 0 Then
'iCar = nombre de caractères à éliminer
'calcule la présence de --GID-- suivi ou non d'un retour ligne
If Left(tData(x, 1), 7) = "--GID--" Then iCar = IIf(Asc(Mid(tData(x, 1), 8, 1)) > 31, 7, 8)
'calcule la présence de <DEC> suivi ou non d'un retour ligne
If Mid(tData(x, 1), iCar + 1, 5) = "<DEC>" Then iCar = IIf(Asc(Mid(tData(x, 1), iCar + 6, 1)) > 31, iCar + 5, iCar + 6)
'calcule la présence du nombre aléatoire
If IsNumeric(Mid(tData(x, 1), iCar + 1, 8)) Then iCar = IIf(Asc(Mid(tData(x, 1), iCar + 9, 1)) > 31, iCar + 8, iCar + 9)
If iCar > 0 Then tData(x, 1) = Right(tData(x, 1), Len(tData(x, 1)) - iCar)
If Left(tData(x, 1), 1) = "=" Or Left(tData(x, 1), 1) = "-" Or Left(tData(x, 1), 1) = "+" Then tData(x, 1) = "'" & tData(x, 1)
End If
Next
Range("Y2:Y" & iRow).Value = tData
Range("Y:Y").WrapText = False
'
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
Selection.Cells(1, 1).Select
Else
Target.WrapText = False
End If
'
End Sub
Où ai-je fais une erreur ???
C'est impressionnant, ça marchait nickel colonne X, je change une colonne, je fais les modifs nécessaire et plus rien ne marche quoi... J'ai du oublier quelques choses.
Bonjour Chantal,
tu n'as pas fait d'erreur : ce sont les conditions d'encodage qui ont changé et que je n'avais pas anticipées.
Pour copier la cellule baladeuse, tu la sélectionnes et tu la "tires" simplement à sa destination.
Encodage
Manifestement, il n'y a pas que le retour-ligne après --GID-- ou <DEC>. Ils utilisent aussi l'espace.
Or, dans mon code précédent, malencontreusement, je l'excluais du calcul : ESPACE = chr(32)
iCar = IIf(Asc(Mid(tData(x, 1), iCar + 6, 1)) > 31, iCar + 5, iCar + 6)
Je l'ai simplement intégré.
Ajout ou retrait de colonne
Pour t'éviter de devoir changer le code lors d'une modification de structure de ton fichier, j'ai inclus une recherche pour déterminer la bonne colonne à traiter.
For x = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(2, x) = "Commentaires Bréhat" Then Exit For
Next
sCol = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
Prière de ne pas modifier l'intitulé de cette colonne et de le laisser en ligne 2!
If Target.Count > 1 Then
Application.EnableEvents = False
Application.ScreenUpdating = False
'
For x = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(2, x) = "Commentaires Bréhat" Then Exit For
Next
sCol = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
'
iRow = Range(sCol & Rows.Count).End(xlUp).Row
tData = Range(sCol & "2:" & sCol & iRow).Value
For x = 1 To UBound(tData)
iCar = 0
If Len(tData(x, 1)) > 0 Then
'iCar = nombre de caractères à éliminer
'calcule la présence de --GID-- suivi ou non d'un retour ligne
If Left(tData(x, 1), 7) = "--GID--" Then iCar = IIf(Asc(Mid(tData(x, 1), 8, 1)) > 32, 7, 8)
'calcule la présence de <DEC> suivi ou non d'un retour ligne
If Mid(tData(x, 1), iCar + 1, 5) = "<DEC>" Then iCar = IIf(Asc(Mid(tData(x, 1), iCar + 6, 1)) > 32, iCar + 5, iCar + 6)
'calcule la présence du nombre aléatoire
If IsNumeric(Mid(tData(x, 1), iCar + 1, 8)) Then iCar = IIf(Asc(Mid(tData(x, 1), iCar + 9, 1)) > 32, iCar + 8, iCar + 9)
If iCar > 0 Then tData(x, 1) = Right(tData(x, 1), Len(tData(x, 1)) - iCar)
If Left(tData(x, 1), 1) = "=" Or Left(tData(x, 1), 1) = "-" Or Left(tData(x, 1), 1) = "+" Then tData(x, 1) = "'" & tData(x, 1)
End If
Next
Range(sCol & "2:" & sCol & iRow).Value = tData
Range(sCol & ":" & sCol).WrapText = False
'
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
Selection.Cells(1, 1).Select
Else
Target.WrapText = False
End IfA+
Chantal ???
Merci bien, je vais essayer ça. Je reviens pour faire un compte rendu de cette nouvelle mise à jour, je te remercie encore et encore du temps que tu passes pour moi.