Convertir des données d'une cellule vers la même cellule
Bonjour,
N'arrivant pas à trouver comment faire, je cherche un moyen de convertir des données de cellules via VBA en fonction du retour à la ligne, et dans la même cellule initiale que celle qui contient les données à convertir.
Je vous ai mis un fichier explicatif en PJ. Globalement je souhaite :
- convertir des données en fonction du Chr(10) ;
- supprimer dans chaque cellule ainsi remplie les préfixes en trop (ce qui est avant les ":").
Et tout cela à l'aide d'une macro VBA
Merci d'avance si vous arrivez à m'aider sur le sujet !
Bonjour à tous !
Une approche, sans VBA, du type "formule unique et dynamique" :
=LET(
t;A2:B5;
prénom;PRENDRE(t;;1);
inform;PRENDRE(t;;-1);
v;ASSEMB.H(prénom;EXCLURE(REDUCE("";inform;LAMBDA(a;c;ASSEMB.V(a;LET(i;TEXTE.APRES(TEXTE.AVANT(c;"Couleur");": ");
ASSEMB.H(i;FRACTIONNER.TEXTE(SUBSTITUE(SUBSTITUE(TEXTE.APRES(c;"Couleur : ");"Texte ";"");"Autre ";"");":"))))));1));
ASSEMB.V(ASSEMB.H("Prénom";"Informations";"Info " & SEQUENCE(;COLONNES(v)-2;2));v)qui retourne l'entièreté du tableau :
Bonjour JFL,
Merci pour la proposition, je vais essayer de ce pas !
En revanche, je souhaite réaliser cette action par du VBA car elle fait partie d'une procédure qui est complètement en VBA
Merci encore en tout cas, et si je ne trouve pas comment faire, j'essaierai de l'adapter à mon fichier !
Bonjour,
Cette fois ci une approche en VBA
bouton "CommandButton" pour activer le code
A+
Attention: petite étourderie de ma part, j'ai oublié de traiter la colonne D, à toi de résoudre cette étourderie, sinon tu me recontactes
Salut Nicolippy,
Salut les as,
un double-clic pour démarrer la macro, les références pour l'affichage devant être adaptées à la situation réelle, évidemment
Dim tSplit
'
Cancel = True
For x = 2 To 5
tSplit = Split(Cells(x, 2), Chr(10))
For y = LBound(tSplit) To UBound(tSplit)
Cells(8 + x, 2 + y) = Split(tSplit(y), " : ")(1)
Next
NextA+
Bonjour à tous,
Une autre proposition : si vous avez vraiment un grand nombre de lignes, elle est plus optimisée. (résultat instantané sur +1000 lignes).
Il suffit d'ajuster les 2 premières variables SrcHautGauche et destinationHautGauche sur les cellules (haut gauche) de votre tableau de base et d'arrivée. La fonction s'adapte au nombre de colonnes/lignes automatiquement. Par contre vous aviez des colonnes en rab "inutiles" (info 5 / 6) donc elles ne sont pas remplies justement.
La fonction gère les espaces ou non avant/après les séparateurs.
Sub ExtractionTexte()
' Variables adaptables
Dim SrcHautGauche As Range
Set SrcHautGauche = ThisWorkbook.Worksheets("Feuil1").Range("A1")
Dim destinationHautGauche As Range
Set destinationHautGauche = ThisWorkbook.Worksheets("Feuil1").Range("A15")
' structure du tableau
With SrcHautGauche
Range(.Cells, .End(xlToRight)).Copy destinationHautGauche
Range(.Offset(1, 0).Cells, .Offset(1, 0).End(xlDown)).Copy destinationHautGauche.Offset(1, 0)
End With
Dim datas As Variant
With SrcHautGauche.Offset(1, 1)
datas = Range(.Cells, .End(xlDown)).Value2
End With
datas = WorksheetFunction.Transpose(datas)
Dim i As Long, j As Long, val As String
For i = LBound(datas) To UBound(datas)
datas(i) = Split(datas(i), Chr(10))
For j = LBound(datas(i)) To UBound(datas(i))
val = CStr(datas(i)(j))
datas(i)(j) = Trim$(Right$(val, Len(val) - InStrRev(val, ":")))
Next j
Next i
With WorksheetFunction
datas = .Transpose(.Transpose(datas))
End With
With destinationHautGauche.Offset(1, 1).Resize(UBound(datas, 1), UBound(datas, 2))
.Value2 = datas
.Borders.LineStyle = xlContinuous
End With
End SubSalut Saboh,
pas inutile, cette manip sur les espaces autour de ":" !
Plus rapide ainsi, quand même, non? Ou j'ai raté un truc... encore!
Trim(Split(tSplit(y), ":")(1))A+
Salut @curulis !
Trim(Split(tSplit(y), ":")(1))
Ah oui je n'y avais pas pensé...
EDIT : Le petit soucis avec Split()(1) c'est que s'il manque les ":" tu lèves une erreur (indice trop haut), alors que je renvoie l'ensemble de la ligne. À voir ce que l'on préfère.
Bonsoir à vous, Curulis et Saboh,
Suite à vos interventions vous m'incitez à ne plus répondre aux post de notre Forum
Pour cette question j'ai fait une proposition, certes "lourde" mais fonctionnelle et toi, Curulis, tu me l'allège avec beaucoup de brio ...... bravo et merci
Quant à toi, saboh, comme toujours, tu nous sors le summum de ce que l'on peut écrire, que dire après cela si ce n'est que je n'ai plus qu'à me taire (lol)
Je suis très reconnaissant car avec vous je progresse et ne reste pas terre à terre au niveau de mes créations de code, merci à vous, et au plaisir de vous retrouver
Jacky
Salut les as,
@Saboh, tu as tout à fait raison. Mes codes ne sont souvent qu'une démo en fonction de la demande qui ne s'embarrassent pas toujours de garde-fou!
Le petit soucis avec Split()(1) c'est que s'il manque les ":" tu lèves une erreur
@Jacky, je ne voudrais surtout pas te décourager!
J'ai écrit parfois de grosses bêtises quand j'ai démarré sur le forum. Dans quelques semaines ou mois, tu seras sans doute plus fort que moi si tu t'appliques.
Perso, je reste (c'est une erreur, je sais) sur mes acquis et je fais de la résistance sur le reste!
Bon travail!
Attention ! le LouReeD veille !
Et dans LouReeD il y a Lour ! comme mes codes parfois !
Mais bon pour curulis, c'est plutôt 2016 !
Jacky, rassurez vous, vous n'êtes pas le seul avec cette impression ! Pour moi c'est les réponses PQ qui font que de plus en plus je répond de moins en moins... Peut-être que cela va me permettre de me relancer dans "la quête des héros !" Sait-on jamais...
@ bientôt
LouReeD
Ouais, JFL, j'assume et je revendique!
Mon avenir informatique étant derrière moi, je m'amuse!
Ma lourdeur de code ? Télécharger mes applications pour vous en rendre compte !
@ bientôt
LouReeD
Bah, LouReed, sans doute la frustration de cette abréviation fécale!
À côté de VBA, Very Best Application, évidemment!
Par contre, je ne baisserai jamais les bras devant ce brol immangeable!
Sans rancune!
Bonsoir à tous,
Wouah, que de méthodes à tester ce soir
Mention spécialé à @saboh12617, ton bout de code fait parfaitement le travail (oui j'aurais probablement des lignes et des lignes à traiter, + de 2000 parfois...).
Une autre question me vient alors, comment faire fonctionner cette belle macro si à tout hasard une ou plusieurs des lignes est/sont vides ? Car ce n'est pas drôle sinon !
Les utilisateurs peuvent parfois ne pas renseigner d'informations, et supprimer le masque présent par souci de clarté (pour eux). Il faut donc que le code soit capable de passer outre ces lignes vides
Merci encore de votre travail collectif en tout cas, c'est génial !
Salut Nicolippy,
Salut Saboh et tous les as,
Une solution VBA (installé nativement dans Excel depuis 1993)
Plus court, je ne peux pas!
- passe les lignes vides
- garde l'info intacte pour les lignes non vides (ligne Pierre) mais sans saut de ligne ni de ":"
- si pas de saut de ligne (ligne Guillaume) mais des ":", garde le string suivant le ":" mais en splittant un éventuel espace
Un double clic démarre la macro avec résultats en [A10].
Si convaincu, remplacer ...
Range("A10").Resize(UBound(tTab, 1), UBound(tTab, 2)).Value = tDatapar...
Range("A2").Resize(UBound(tTab, 1), UBound(tTab, 2)).Value = tDataDim tTab, tData, tSplit, sFlag$
'
Cancel = True
tTab = Range("A2").Resize(Range("A" & Rows.Count).End(xlUp).Row - 1, Cells(1, Columns.Count).End(xlToLeft).Column).Value
tData = tTab
'
For x = 1 To UBound(tTab, 1)
If tTab(x, 2) <> "" Then
sFlag = IIf(InStr(tTab(x, 2), Chr(10)) > 0, Chr(10), ":")
tSplit = Split(tTab(x, 2), sFlag)
For y = LBound(tSplit) To UBound(tSplit)
If sFlag = Chr(10) And InStr(tTab(x, 2), ":") > 0 Then tData(x, y + 2) = Trim(Split(tSplit(y), ":")(1))
If sFlag = ":" And InStr(tTab(x, 2), ":") > 0 And y > 0 Then tData(x, y + 1) = Split(Trim(tSplit(y)), " ")(0)
Next
End If
Next
Range("A10").Resize(UBound(tTab, 1), UBound(tTab, 2)).Value = tDataIl nous faudrait un fichier réaliste (sans données confidentielles) mais avec les erreurs fréquemment rencontrées pour tester valablement.
Pas tirer sur le pianiste, siouplaît!
A+
Bonjour à tous,
@jacky, il ne faut pas voir les choses comme ça, autrement qui aiderait ? Il y a toujours quelqu'un de plus expérimenté, ce n'est pas une raison pour essayer bien au contraire ! Pour dire la vérité je participe aussi sur un forum anglais, et les pointures qui s'y trouvent me donnent souvent l'impression de faire des solutions "brouillon". Mais bon, je prends du recul et j'essaie d'assimiler leurs méthodes pour les réutiliser, il faut en profiter 😁.
N'oublions pas qu'on a tous débuté. Le code que tu as proposé a le mérite d'être très clair, même pour un néophyte en VBA, là où ma proposition fait mal à la tête. C'est d'ailleurs pour ça que j'ai précisé "si vous avez un grand nombre de lignes". Ca ne sert à rien d'utiliser un bazooka pour tuer une mouche.
@Nicolippy, ci-après ma macro MAJ pour aller chercher la dernière ligne utilisée de la colonne. J'ai aussi un peu revu le remplissage du tableau pour avoir exactement autant de colonnes de sortie que d'en-têtes : dans ton exemple joint, si tu supprimes "info 3,4 etc" tu n'auras que les 2 premières infos. Si tu ajoutes "info 7,8" elles seront bien remplies (de vide, mais avec les contours).
Sub ExtractionTexte()
' Variables adaptables
Dim SrcHautGauche As Range
Set SrcHautGauche = ThisWorkbook.Worksheets("Feuil1").Range("A1")
Dim destinationHautGauche As Range
Set destinationHautGauche = ThisWorkbook.Worksheets("Feuil1").Range("P1")
Dim nbCol As Long
' structure du tableau
With SrcHautGauche
With Range(.Cells, .End(xlToRight))
.Copy destinationHautGauche
nbCol = .Columns.Count - 1
End With
Range(.Offset(1, 0).Cells, .Worksheet.Cells(Rows.Count, .Column).End(xlUp)).Copy destinationHautGauche.Offset(1, 0)
End With
Dim datas As Variant
With SrcHautGauche.Offset(1, 1)
datas = Range(.Cells, .Worksheet.Cells(Rows.Count, .Column).End(xlUp)).Value2
End With
datas = WorksheetFunction.Transpose(datas)
Dim datas2() As String ' Remplacer par "As Variant" pour conserver les nombres en nombres
ReDim datas2(LBound(datas) To UBound(datas), 1 To nbCol)
Dim i As Long, j As Long, val As String, splitRes As Variant
For i = LBound(datas) To UBound(datas)
splitRes = Split(datas(i), Chr(10))
For j = LBound(datas2, 2) To UBound(datas2, 2)
If j <= UBound(splitRes) Then
val = CStr(splitRes(j))
val = Trim$(Right$(val, Len(val) - InStrRev(val, ":")))
Else
val = vbNullString
End If
datas2(i, j) = val
Next j
Next i
With destinationHautGauche.Offset(1, 1).Resize(UBound(datas2, 1), UBound(datas2, 2))
.Value2 = datas2
.Borders.LineStyle = xlContinuous
End With
End SubPS : voir le commentaire sur Dim datas2() pour définir le type des variables texte/nombre.
Bonjour ,
Je te remercie vivement pour tes encouragements.
Suite à ceux-ci je persèverai tout en essayant de développer de mieux en mieux
Un grand merci et très cordialement
Jacky