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

 

[ROGER2327]

Re : Insertion champs déconcaténés

Re...

À JNP :

Merci pour cette réponse qui me rassure. Effectivement, le problème de la colonne U est peut-être une erreur de notre ami. (J'aurais apprécié qu'il le dise dans le message #11...)

Reste un problème. Chez moi, les dates sont correctes. Si elles ne le sont pas chez vous, c'est que mon code s'exécute différemment dans des environnements différents. Je vais essayer de comprendre pourquoi.

Merci encore pour cette réponse.​

ROGER2327
#4083

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

 

[JNP]

Re : Insertion champs déconcaténés

Re 🙂,

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.

C'est ce que j'expliquais dans mon #14, grâce à Roger qui m'a fait prendre conscience de mon erreur 😉.

Reste un problème. Chez moi, les dates sont correctes. Si elles ne le sont pas chez vous, c'est que mon code s'exécute différemment dans des environnements différents. Je vais essayer de comprendre pourquoi.

C'est encore plus bizarre que je ne pensais. J'ai appliqué votre macro sur une feuille et la mienne sur l'autre. J'ai voulu mettre en place une MFC pour différencier (en orange) et les cellules dites différentes sont de même valeur visuelles, alors que celle qui ne sont pas bonnes (que j'ai mis en rouge) sont considérées comme identiques 😕...
Je vous mets le fichier en pièce jointe.
Bonne soirée 😎

 

[ROGER2327]

Re : Insertion champs déconcaténés

Re...

Merci de poursuivre la discussion. Il me semble que j'ai proposé une mauvaise solution. Peut-être ceci corrige-t-il le tir ?

[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 = ";" 'Séparateur
   With [A1] 'Première cellule de données
      c1 = 1 - .Column + [M1].Column 'Première colonne à diviser
      c2 = 1 - .Column + [N1].Column 'Deuxième colonne à diviser
      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) = CLng(CDate(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))
      .Resize(1, u).Copy
      With .Resize(n + (n > 1), u)
         .PasteSpecial xlPasteFormats
         .Value = WorksheetFunction.Transpose(sDat)
      End With
   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
#4085

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

 

[JNP]

Re : Insertion champs déconcaténés

Re 🙂,
Le résultat est correct 😉.
Par contre, tout le code passant par des tableaux, je n'ai pas vraiment suivi où l'erreur avait été réparée 😱.
Mais bon, l'important est que nos 2 codes, chacun après correction, soient efficaces 😛.
Bonne soirée 😎

 

[ROGER2327]

Re : Insertion champs déconcaténés

Re...

Merci pour votre assistance. J'espère que le code est maintenant entièrement correct.
La modification porte sur cette ligne :

[COLOR="DarkSlateGray"][B]            For j = 0 To UBound(a): sDat(c1, n + j) = [COLOR="Red"]CLng(CDate(a(j)))[/COLOR]: Next[/B][/COLOR]

au lieu de :

[COLOR="DarkSlateGray"][B]            For j = 0 To UBound(a): sDat(c1, n + j) = [COLOR="Red"]a(j)[/COLOR]: Next[/B][/COLOR]

et sur la suppression de quelques lignes inutiles en fin de procédure.
Quant au recours aux tableaux plutôt qu'à la manipulation directe de la feuille, il est dicté par un souci de rapidité d'exécution pour le cas où il s'agirait de traiter un grand nombre de lignes. Mais je n'ai pas fait de test sérieux pour vérifier que cette solution apporte un gain de temps significatif...

Cordialement,​

ROGER2327
#4089

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