Insertion champs déconcaténés

[Membre supprimé 156683]

Bonjour à tous,

Voilà je ne sais pas comment m'y prendre pr résoudre le problème suivant:

Je dois réaliser une macro (et pas un filtre) sur un tableau de milliers de lignes parmi lesquelles je dois déconcaténer des cellules (quand elle comporte plusieurs métadonnées) puis insérer une ligne en dessous pour y mettre les informations.

Exemple:

Ce que j'ai:

4| A1;A2 | B1;B2

5| A3 | B3

6| A4 | B4


Ce que je dois obtenir:

4| A1 | B1

5| A2 | B2

6| A3 | B3

7| A4 | B4

Le problème n'est pas tant la déconcaténation mais plutôt l'insertion de la nouvelle ligne puis d'y mettre les métadonnées.

précision: il existe des cellules à déconcaténer qui comporte 3 métadonnées, il faudrait donc insérer les 2 lignes supplémentaires et controler que A2 est bien sur la mm ligne que B2 (pr en revenir à mon exemple)

Si vous avez une idée 🙂

Merci d'avance,

M&m

 

[pierrejean]

Re : Insertion champs déconcaténés

Bonjour Master and molotov

En supposant que chaque colonne ait pour chaque ligne le même nombre de metadonnées
Sinon poster un exemple plus detaillé

Sub report()
ligne = 2
tablo = Range("A2:B" & Range("A65536").End(xlUp).Row)
For n = LBound(tablo, 1) To UBound(tablo, 1)
x = Split(tablo(n, 1), ";")
y = Split(tablo(n, 2), ";")
 For m = LBound(x) To UBound(x)
  With Sheets("Feuil2")
   .Cells(ligne, 1) = x(m)
   .Cells(ligne, 2) = y(m)
  ligne = ligne + 1
  End With
 Next m
Next n
Sheets("Feuil2").Select
End Sub

Salut JNP
Salut ROGER

 

[JNP]

Re : Insertion champs déconcaténés

Bonsoir le fil 🙂,
Pierre-Jean (que je salue) a du avoir un problème de post 😛.

Sub Test()
Dim I As Long, J As Long, K As Integer, ColA, ColB
I = 4
J = 4
While Cells(I, 1) <> ""
ColA = Split(Cells(I, 1), ";")
ColB = Split(Cells(I, 2), ";")
If UBound(ColA) <> UBound(ColB) Then
MsgBox "Erreur en ligne " & I
Exit Sub
Else
For K = LBound(ColA) To UBound(ColA)
Cells(J, 3) = ColA(K)
Cells(J, 4) = ColB(K)
J = J + 1
Next K
End If
I = I + 1
Wend
Range("A:B").Delete
End Sub

devrait faire l'affaire.
Bonne soirée 😎

 

[ROGER2327]

Re : Insertion champs déconcaténés

Bonsoir à tous

Une autre proposition :

[COLOR="DarkSlateGray"][B]Sub toto()
Dim i&, j&, n&, l&, a, b, s$, oPlg, oDat(), sDat(), par(1 To 2)
   With Application
      par(1) = .EnableEvents: par(2) = .Calculation
      .Calculation = xlCalculationManual: .EnableEvents = False: .ScreenUpdating = False
   End With
   s = ";" [COLOR="SeaGreen"]'Séparateur[/COLOR]
   With Range("A4") [COLOR="SeaGreen"]'Première cellule de données[/COLOR]
      Set oPlg = Range(.Cells, Cells(WorksheetFunction.Max(.Row, Cells(Rows.Count, .Column).End(xlUp).Row, Cells(Rows.Count, .Column + 1).End(xlUp).Row), .Column + 1))
      ReDim oDat(1 To oPlg.Rows.Count, 1 To 2)
      oDat = oPlg.Value
      oPlg.Clear
      Set oPlg = Nothing
      n = 1
      ReDim sDat(1 To 2, 1 To n)
      For i = 1 To UBound(oDat, 1)
         a = Split(oDat(i, 1), s)
         b = Split(oDat(i, 2), s)
         l = WorksheetFunction.Max(UBound(a), UBound(b))
         If l >= 0 Then
            ReDim Preserve sDat(1 To 2, 1 To n + l + 1)
            For j = 0 To UBound(a): sDat(1, n + j) = a(j): Next
            For j = 0 To UBound(b): sDat(2, n + j) = b(j): Next
            n = n + l + 1
         End If
      Next i
      ReDim Preserve sDat(1 To 2, 1 To n + (n > 1))
      .Resize(n + (n > 1), 2).Value = WorksheetFunction.Transpose(sDat)
   End With
   With Application
      .ScreenUpdating = True: .EnableEvents = par(1): .Calculation = par(2)
   End With
End Sub[/B][/COLOR]

ROGER2327
#4071

Vendredi 27 Phalle 137 (Priape, franc-tireur, SQ)
20 Fructidor An CCXVIII
2010-W36-1T23:04:09Z

 

[Membre supprimé 156683]

Re : Insertion champs déconcaténés

Tout d’abord merci à PierreJean, JNP et Roger pour avoir pris le temps de me répondre,

Je vais apporter quelques explications supplémentaires ainsi qu’un extrait du tableau en question :

J’ai testé les différents codes proposés et j’ai remarqué que celui de Pierre Jean recopiait les données dans une feuille différente, celui de JNP (testé sur des colonnes lambda dont les métadonnées étaient séparées par des « ; ») ne prenait pas en compte toutes les données (et me parait un peu obscur à modifier). Celui de Roger fonctionne très bien mais il ne prend pas en compte les casses (dû aux cases vides).

Je n’ai pas été assez clair dans mes explications et je joins un extrait du tableau en question :

En fait il m’a été demandé de réaliser une macro en fonction des colonnes M et N : comme vous pourrez le voir certaines cellules de ces colonnes comporte des données séparées par des « ; » .
L’objectif est d’insérer une ligne (juste en dessous) pour chaque donnée séparée puis d’y mettre les fameuses données en les effaçant de la « cellule mère ».
Je vous ai surligné dans l’exemple les parties modifiées.

Si par exemple j’ai 2 données à séparées, une ligne doit être créée juste en dessous de manière à y insérer les mêmes données sauf au niveau des colonnes M et N dont les données doivent être déconcaténées et bien réparties.

J’espère avoir été clair, je répondrais volontiers si cela manque de précision.

Encore merci,

M&m

 

[JNP]

Re : Insertion champs déconcaténés

Re 🙂,

...
celui de JNP (testé sur des colonnes lambda dont les métadonnées étaient séparées par des « ; ») ne prenait pas en compte toutes les données (et me parait un peu obscur à modifier).
...
Je n’ai pas été assez clair dans mes explications et je joins un extrait du tableau en question :

Normal que ça ne prenne pas en compte toutes les données, il n'y avait aucune cellule vide dans ton exemple 🙄... Or ma macro s'arrête à la première cellule vide 😛.
Obscur à modifier : il faudra que tu m'expliques 😕.
De plus, tu ne nous avais pas demander de dupliquer la ligne 😱 !

Sub Test()
Dim I As Long, K As Integer, ColA, ColB, DerLigne As Long
I = 1
DerLigne = Range("A65536").End(xlUp).Row
While I <= DerLigne
ColA = Split(Cells(I, 13), ";")
ColB = Split(Cells(I, 14), ";")
If UBound(ColA) <> UBound(ColB) Then
MsgBox "Erreur en ligne " & I
Exit Sub
ElseIf UBound(ColA) <> LBound(ColA) And UBound(ColA) <> -1 Then
For K = LBound(ColA) To UBound(ColA)
If K <> UBound(ColA) Then
Rows(I).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
DerLigne = DerLigne + 1
End If
Rows(I + 1).Copy Rows(I)
Cells(I, 13) = ColA(K)
Cells(I, 14) = ColB(K)
I = I + 1
Next K
Else
I = I + 1
End If
Wend
End Sub

devrait fonctionner 😀.
Bonne soirée 😎

 

[Membre supprimé 156683]

Re : Insertion champs déconcaténés

Salut JNP,

merci de m'avoir repondu aussi vite ^^

Je t'ai dit "obscur à modifier" car n'étant pas très calé en vba, je me suis retrouvé tout bète devant ton code sans savoir quoi modifier.

Et c'est un peu le même cas sur ton nouveau code :x : j'ai l'impression que tu n'utilises que des variables, je ne sais donc pas quoi modifier pour lui indiquer les bonnes colonnes car pour l'instant sur des colonnes lambda A et B, rien ne se passe quand je lance la macro (mais il ne me retourne aucune erreur).

N'utilises tu pas des fonctions non implémentées dans la version 2003 ?

Merci,

M&m

 

[JNP]

Re : Insertion champs déconcaténés

Re 🙂,
Il est tout simplement formaté pour le fichier test que tu as fourni, en ôtant le tableau de ce que tu attends 😛.
Je vais te commenter le code (dès que j'ai 5 mn 😀), mais il ne me paraissait pas plus obscur que les autres 🙄...
A + 😎

 

[JNP]

Re : Insertion champs déconcaténés

Re 🙂,

[COLOR=blue]Sub[/COLOR] Test()
[COLOR=blue]Dim[/COLOR] I [COLOR=blue]As Long[/COLOR], K [COLOR=blue]As Integer[/COLOR], ColA, ColB, DerLigne [COLOR=blue]As Long[/COLOR]
[COLOR=green]' déclaration des variables[/COLOR]
I = 1 [COLOR=green]' première ligne du tableau à traiter qui sera incrémentée ensuite[/COLOR]
DerLigne = Range("A65536").End(xlUp).Row
[COLOR=green]' dernière ligne du tableau à traiter[/COLOR]
[COLOR=blue]While[/COLOR] I <= DerLigne
[COLOR=green]' tant que la ligne à traiter est plus petite que la dernière[/COLOR]
ColA = Split(Cells(I, 13), ";")
[COLOR=green]' ColA : tableau qui reçoit les valeurs séparées par le ; et qui aura[/COLOR]
[COLOR=green]' les valeurs ColA(0)="27/05/2010" et ColA(1)="28/05/2010" par exemple[/COLOR]
[COLOR=green]' après le Split de "27/05/2010;28/05/2010" qui se trouve en[/COLOR]
[COLOR=green]' cellule ligne I et colonne 13 (M)[/COLOR]
ColB = Split(Cells(I, 14), ";")
[COLOR=green]' Idem pour la colonne N[/COLOR]
[COLOR=blue]If UBound[/COLOR](ColA) <> [COLOR=blue]UBound[/COLOR](ColB) [COLOR=blue]Then[/COLOR]
[COLOR=green]' si les tableau ne font pas la même taille[/COLOR]
MsgBox "Erreur en ligne " & I
[COLOR=green]' message d'erreur car ça veut dire qu'il n'y avait pas le même[/COLOR]
[COLOR=green]' nombre de ; dans les cellules contigües[/COLOR]
[COLOR=blue]Exit Sub[/COLOR]
[COLOR=green]' puis sortir de la macro[/COLOR]
[COLOR=blue]ElseIf UBound[/COLOR](ColA) <> [COLOR=blue]LBound[/COLOR](ColA) [COLOR=blue]And UBound[/COLOR](ColA) <> -1 [COLOR=blue]Then[/COLOR]
[COLOR=green]' sinon, si il n'y a pas une seule valeur ou aucune[/COLOR]
[COLOR=green]' (LBound donne le premier indice et UBound le dernier)[/COLOR]
[COLOR=blue]For[/COLOR] K = [COLOR=blue]LBound[/COLOR](ColA) [COLOR=blue]To UBound[/COLOR](ColA)
[COLOR=green]' pour K variant du premier au dernier indice[/COLOR]
[COLOR=blue]If[/COLOR] K <> [COLOR=blue]UBound[/COLOR](ColA) [COLOR=blue]Then[/COLOR]
[COLOR=green]' si ce n'est pas le dernier indice[/COLOR]
Rows(I).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
[COLOR=green]' insertion d'une ligne au dessus en gardant la mise en forme[/COLOR]
DerLigne = DerLigne + 1
[COLOR=green]' et évidement, la dernière ligne est descendue[/COLOR]
[COLOR=blue]End If[/COLOR]
[COLOR=green]' fin du test pour l'insertion de ligne[/COLOR]
Rows(I + 1).Copy Rows(I)
[COLOR=green]' copie de la ligne d'origine dans la nouvelle ligne[/COLOR]
Cells(I, 13) = ColA(K)
[COLOR=green]' envoi de la valeur déconcaténée colonne M[/COLOR]
Cells(I, 14) = ColB(K)
[COLOR=green]' idem colonne N[/COLOR]
I = I + 1
[COLOR=green]' incrémentation de la ligne[/COLOR]
[COLOR=blue]Next[/COLOR] K
[COLOR=green]' K suivant[/COLOR]
[COLOR=blue]Else[/COLOR]
[COLOR=green]' sinon[/COLOR]
I = I + 1
[COLOR=green]' je passe à la ligne suivante[/COLOR]
[COLOR=blue]End If[/COLOR]
[COLOR=green]' fin de test[/COLOR]
[COLOR=blue]Wend[/COLOR]
[COLOR=green]' renvoi sur la boucle While[/COLOR]
[COLOR=blue]End Sub[/COLOR]

Bon courage 😎

 

[ROGER2327]

Re : Insertion champs déconcaténés

Bonjour à tous

Une fois de plus, nous avions à résoudre une problème qui ne se posait pas :

Ce que j'ai:

4| A1;A2 | B1;B2

5| A3 | B3

6| A4 | B4


Ce que je dois obtenir:

4| A1 | B1

5| A2 | B2

6| A3 | B3

7| A4 | B4

Le vrai problème était celui-ci :

Ce que j'ai:

4| A1;A2 | B1;B2
5| A3 | B3
6| A4 | B4

Ce que je dois obtenir:

4| A1 | B1
4| A2 | B2
5| A3 | B3
6| A4 | B4

À vrai dire, ce nouveau problème n'est sûrement pas encore le vrai. En effet, s'il s'agissait de ce problème, on s'attendrait à devoir trouver nulldate partout dans la colonne U après traitement des données du classeur exemple-2.
Mais il n'en est rien : les cellules U2, U7 et U8 doivent être vides après traitement.
J'ai beau lire et relire les messages #1 et #5, je ne trouve pas sur quel critère est fondé ce résultat...

En attendant, voici un essai qui semble donner le résultat attendu sauf pour la colonne U :

Ajout : Ce code est fautif. Voir le message #18 pour une version plus correcte.

[COLOR="DarkSlateGray"][B]Sub toto()
Dim i&, j&, k&, c1&, c2&, n&, l&, u&, a, b, s$, oPlg, oDat(), sDat(), par(1 To 2), loc As Range
   With Application
      par(1) = .EnableEvents: par(2) = .Calculation
      .Calculation = xlCalculationManual: .EnableEvents = False: .ScreenUpdating = False
   End With
   Set loc = Selection
   s = ";" [COLOR="SeaGreen"]'Séparateur[/COLOR]
   With [A1] [COLOR="SeaGreen"]'Première cellule de données[/COLOR]
      c1 = 1 - .Column + [M1].Column [COLOR="SeaGreen"]'Première colonne à diviser[/COLOR]
      c2 = 1 - .Column + [N1].Column [COLOR="SeaGreen"]'Deuxième colonne à diviser[/COLOR]
      Set oPlg = Range(.Cells, Cells(Cells(Rows.Count, .Column).End(xlUp).Row, Cells(.Row, Columns.Count).End(xlToLeft).Column))
      u = oPlg.Columns.Count
      ReDim oDat(1 To oPlg.Rows.Count, 1 To u)
      oDat = oPlg.Value2
      Set oPlg = Nothing
      n = 1
      ReDim sDat(1 To u, 1 To n)
      For i = 1 To UBound(oDat, 1)
         a = Split(oDat(i, c1), s)
         b = Split(oDat(i, c2), s)
         l = WorksheetFunction.Max(0, UBound(a), UBound(b))
         ReDim Preserve sDat(1 To u, 1 To n + l + 1)
         For j = n To n + l: For k = 1 To u: sDat(k, j) = oDat(i, k): Next: Next
         If l > 0 Then
            For j = 0 To UBound(a): sDat(c1, n + j) = a(j): Next
            For j = 0 To UBound(b): sDat(c2, n + j) = b(j): Next
         End If
         n = n + l + 1
      Next i
      Erase oDat
      ReDim Preserve sDat(1 To u, 1 To n + (n > 1))
      .Offset(0, c1 - 1).NumberFormat = "@"
      .Resize(1, u).Copy
      With .Resize(n + (n > 1), u)
         .PasteSpecial xlPasteFormats
         .Value = WorksheetFunction.Transpose(sDat)
      End With
      .Offset(0, c1 - 1).Resize(n + (n > 1), 1).NumberFormat = "mm/dd/yyyy"
   End With
   Erase sDat
   loc.Select
   Set loc = Nothing
   With Application
      .ScreenUpdating = True: .EnableEvents = par(1): .Calculation = par(2)
   End With
End Sub[/B][/COLOR]

ROGER2327
#4072

Dimanche 1er Absolu 138 (Nativité d' Alfred Jarry, SPp)
22 Fructidor An CCXVIII
2010-W36-3T00:43:53Z

 

[Membre supprimé 156683]

Re : Insertion champs déconcaténés

Merci beaucoup JNP pour ton code et pour les commentaires que tu as rajouté,
Merci ROGER pour t'être à nouveau penché sur mon problème.

JNP, ton code fonctionne parfaitement, il y a juste un pti problème dont je ne trouve pas la source dans ton code:

Si tu reprends mon exemple tu peux voir à la ligne 4 dans la colonne des dates (cellule surlignée en jaune) la date 12/07/2010:

Quand j'applique la macro je me suis aperçu que les mois et les jours s'inversent: cette date devient 07/12/2010, ce qui est très bizarre, car sur la première déconcaténation la première date de la chaine à déconcaténer ne change pas.

Je me suis aperçu que dans mon tableau complet l'erreur se reproduisait également.

A quoi cela peut il être dû ?

M&m

 

[JNP]

Re : Insertion champs déconcaténés

Re 🙂,
Cela est du au fait que Excel prends la date au format anglais au lieu du format français quand le jour est inférieur à 12 🙄...
Pour éviter le problème, modifie

' copie de la ligne d'origine dans la nouvelle ligne
Cells(I, 13).FormulaLocal = ColA(K)

et ça devrait fonctionner 😉.
Bon courage 😎

 

[ROGER2327]

Re : Insertion champs déconcaténés

Bonjour à tous

Je n'ai décidément rien compris au problème, puisque je ne trouve pas les mêmes résultats que JNP (bonjour au passage) pour les cellules E2, H2, I2, J2, M5, E7, H7 et I7 et, bien sûr, M5.
Pour cette dernière, la correction proposée par JNP fonctionne.
Pour les autres, je ne comprends pas la logique. Par exemple, pourquoi doit-on trouver IN en J2, et non RE ? Ou 03/08/2010 en H7, et non 07/06/2010 ?

Comme j'ai passé un certain temps (et même un temps certains !) sur ce problème, je serais ravi si quelqu'un pouvait m'éclairer.
(Et tant qu'à faire, si quelqu'un à compris la logique qui gouverne la colonne U, je suis preneur.)

Merci d'avance.​

ROGER2327
#4081

Dimanche 1er Absolu 138 (Nativité d' Alfred Jarry, SPp)
22 Fructidor An CCXVIII
2010-W36-3T14:31:29Z

 

[JNP]

Re : Insertion champs déconcaténés

Bonjour Roger 🙂,
Effectivement, vous avez raison, mes résultats sont faut, j'ai mal placé un If. Le bon ordre est

If k <> UBound(ColA) Then
' si ce n'est pas le dernier indice
Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' insertion d'une ligne au dessus en gardant la mise en forme
Rows(i + 1).Copy Rows(i)
' copie de la ligne d'origine dans la nouvelle ligne
DerLigne = DerLigne + 1
' et évidement, la dernière ligne est descendue
End If
' fin du test pour l'insertion de ligne
Cells(i, 13).FormulaLocal = ColA(k)
' envoi de la valeur déconcaténée colonne M
Cells(i, 14) = ColB(k)

car je faisais la copie après le test 😱.
Pour la colonne U, je ne sais pas non plus étant donné que j'obtiens la même que vous, je pense que c'était une erreur de notre ami dans l'écriture de ce qu'il attendait 🙄.
Je n'avais pas encore testé votre code, mais le résultat obtenu est équivalent au mien (maintenant que je l'ai rectifié) avec une méthode très différente. Vous avez le même défaut d'inversion de date anglaise que ma première version, mais pas aux mêmes endroits 😕, pourtant, j'ai bien vu que vous avez mis un Format...
Bonne soirée 😎

 

[Membre supprimé 156683]

Re : Insertion champs déconcaténés

Tout à l'heure j'ai omis de te faire part d'un autre petit soucis, JNP:

quand la nouvelle ligne est insérée, avec ta macro , elle prend les valeurs de la ligne du dessous (sauf les 2 colonnes qui se déconcatènent parfaitement avec les bonnes métadonnées).

La nouvelle ligne insérée doit avoir les mêmes valeurs que la ligne "mère" sauf pr les déconcaténations, or elle prend les valeurs de ligne suivante actuellement.

J'espère avoir été assez clair 🙂

M&m

P.S: sinon pr le problème de date, c'est résolu grâce à la fonction que tu as donné