Discussion :

[Arthursl]

Bonjour à tous,

Voilà ma problématique : j'ai une référence avec plusieurs numéro de série (jusque là rien d'anormal) et j'ai un tableur qui se présente sous cette forme

colonne E : référence colonne T : numéro de série

sauf que les numéro de séries sont concaténés ensemble (exemple : 1¤2¤3¤4¤5).

Mon but final est d'avoir 1 ligne = 1 ref et numéro de série. Est-il donc possible de le faire en macro ? je n'arrive pas à le faire... (le but serait donc d'insérer une ligne identique à la ligne du dessus (et à la suite de celle-ci), d'identifier le signe ¤ et de copier le reste du texte sur la ligne d'après, tout en supprimant le signe ¤.
Ma première ligne est une ligne de titre, le tableau s'arrête en ligne U.

N'hésitez pas à me demander plus d'informations si besoin, et merci d'avance pour votre aide !

[MarcelG]

Bonjour Arthur, Bonjour au Forum,

Bienvenue sur le forum,

A chaque valeur de série, tu peux associer un tableau à une dimension (Array), obtenu par la fonction Split. Voir cet espace.
Ensuite insérer le nombre de lignes égal au nombre d'éléments de ce tableau (Ubound) -1. Voir cet espace
L'opération s'effectuerait en partant de la dernière ligne.

Essaie de développer dans ce sens et n'hésite pas à revenir en présentant ton code.

[MarcelG]

Salut Arthur,

Plus sioux qu'il n'y paraît.

Le code suivant décomposera la cellule en autant de lignes que le séparateur(ici "-") doit disjoindre.
Ensuite, les cellules adjacentes sont recopiées vers les cellules créées

Je considère la plage débutant en A2.

Nota:
L'instruction Activate, que je rejette le plus souvent, a pour fonction la gestion du bloc With.

Bien entendu, code à adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Option Explicit
 
Public Sub insertion_split()
 
Dim dernl As Long, i As Long, dernc As Byte
Dim sp As Variant
Dim u As Byte, j As Byte
Dim d As Range, f As Range
 
Application.ScreenUpdating = False
 
With Worksheets("labase")
        'Afin de gérer les blocs
        .Activate
        dernl = .Cells(.Rows.Count, 1).End(xlUp).Row
        dernc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = dernl To 2 Step -1
                With .Cells(i, 1)
                        sp = Split(.Value, "-")
                        u = UBound(sp)
                        Rows(i + 1 & ":" & i + u).Insert Shift:=xlDown
                        For j = 0 To u
                                .Offset(j, 0).Value = sp(j)
                        Next j
                        Set d = .Offset(1, 1)
                        Set f = .Offset(u, dernc - 1)
                        Range(.Offset(0, 1), .Offset(0, dernc - 1)).Copy Destination:=Range(d, f)
                        Set f = Nothing
                        Set d = Nothing
                End With
        Next i
End With
 
Application.ScreenUpdating = True
 
End Sub

Tu intègres ce code ligne par ligne, presque mot à mot, et tu reviens.

A demain.

Bonne soirée à toi, Bonne soirée au Forum

[Arthursl]

Bonsoir MarcelG
Bonsoir le Forum

Merci beaucoup pour ton aide, je suis débutant en vba et j'avoue avoir pas mal de soucis ! J'arrive à lire et adapter mais pas trop créer pour l'instant...
J'essaye ta solution en adaptant et ajoutant 2 ou 3 petits détail et je reviens vers toi !

Merci encore pour ton aide !

[MarcelG]

Bonjour Arthur, Bonjour le Forum,

Comme je te l'ai proposé, tu comprends le code dans son intégralité et tu reviens si au moins une seule seule méthode (action du code) te pose question.

S'IL TE PLAIT, PAS DE COPIER COLLER

En plus que ceux que j'ai indiqués dans mon premier premier post, dans mon billet, par ailleurs, je reporte quelques liens utiles.

Plage de départ



Plage arrivée



Au code initial, j'ai ajouté une condition (élément unique sans séparateur)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Option Explicit
 
Public Sub insertion_split()
 
Dim dernl As Long, i As Long, dernc As Byte
Dim sp As Variant
Dim u As Byte, j As Byte
Dim d As Range, f As Range
 
Application.ScreenUpdating = False
 
With Worksheets("labase")
        'Afin de gérer les blocs
        .Activate
        dernl = .Cells(.Rows.Count, 1).End(xlUp).Row
        dernc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = dernl To 2 Step -1
                With .Cells(i, 1)
                        sp = Split(.Value, "-")
                        u = UBound(sp)
                        If u > 0 Then
                                Rows(i + 1 & ":" & i + u).Insert Shift:=xlDown
                                For j = 0 To u
                                        .Offset(j, 0).Value = sp(j)
                                Next j
                                Set d = .Offset(1, 1)
                                Set f = .Offset(u, dernc - 1)
                                Range(.Offset(0, 1), .Offset(0, dernc - 1)).Copy Destination:=Range(d, f)
                                Set f = Nothing
                                Set d = Nothing
                        End If
                End With
        Next i
End With
 
Application.ScreenUpdating = True
 
End Sub

[Pierre Fauconnier]

Salut.

Avec une version XL égale ou supérieure à la 2010, tu peux réaliser cela avec Power Query

[Pierre Fauconnier]

Par vba, une autre méthode que celle de Marcel (Hello ), qui utilise un array dynamique. Le principe est de créer un array sur base des deux colonnes, puis de splitter les numéros par ligne de tableau et de pousser la paire code/numéro dans le tableau dynamique. A la fin, on transpose le tableau et on le pousse dans une plage redimensionnée pour le recevoir.


Sur base du tableau suivant, à adapter à ton cas. Bien entendu, on travaille avec des tableaux structurés...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub SplitSerialNumbers()
  ReDim t(0 To 1, 0 To 0)
  Dim Values, Temp
  Dim i As Long, j As Long
 
  Values = Range("tableau1").Value
  For i = 1 To UBound(Values)
    Temp = Split(Values(i, 2), "¤")
      For j = 0 To UBound(Temp)
        If Not IsEmpty(t(0, 0)) Then ReDim Preserve t(0 To 1, 0 To UBound(t, 2) + 1)
        t(0, UBound(t, 2)) = Values(i, 1)
        t(1, UBound(t, 2)) = Temp(j)
      Next j
  Next i
  Range("e2").Resize(UBound(t, 2) + 1, 2).Value = Application.Transpose(t)
  Erase t
  Erase Values
  Erase Temp
End Sub

[Arthursl]

Bonjour MarcelG, Bonjour Pierre Fauconnier,
Bonjour le Forum,

MarcelG, j'ai essayé de reprendre ton code et de le modifier pour obtenir le résultat attendu mais je n'y arrive pas... J'ai besoin d'ajouter des lignes en fonction du nombre de signe monétaire dans la cellule et ensuite d'exécuter la fonction split, toujours en fonction du nombre de signe monétaire +1. Je bloque sur la 1ère partie où il faut chercher et stocker le nombre de signe en variable et ajouter des lignes en fonction du résultat obtenu.

en illustrant voila ma plage de départ :

et voila ma plage d'arrivée :


Pierre Fauconnier, je ne connais pas bien le power query, mais si c'est possible de le faire comme ci-dessus je vais me renseigner !

Merci pour vos réponses,
the newby.

[MarcelG]

Salut Arthur, Salut Pierre,

Pierre,

Merci pour cette proposition. Bravo.

Arthur,

Devant partir, je te propose de revenir lundi.

Comme tu le dois, si tu adoptes les tableaux structurés, alors, avant d'envisager le code de Pierre, voici 2 de ses tutoriels
Présentation des tableaux structurés
Gestion des tableaux structurés par VBA

Bon week-end à vous, Bon week-end au Forum.

[Arthursl]

Je reviens avec du neuf !

Après beaucoup de lectures et une grande vérification, j'ai réussi à faire ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub TestSplit()
 
Dim i As Variant
Dim j As Long
Dim e As Long
 
e = Cells(1, 1).CurrentRegion.Rows.Count
j = 2
 
    Do While Cells(j, 1).Value <> ""
 
        If InStr(1, Cells(j, 20).Value, "¤") > 0 Then
 
 
            i = Split(Cells(j, 20), "¤")
 
            Rows(j).Copy
            Rows(j + 1 & ":" & j + UBound(i)).Insert xlShiftDown
            Cells(j, 20).Resize(UBound(i) + 1).Value = Application.WorksheetFunction.Transpose(i)
            Application.CutCopyMode = False
 
        End If
 
    j = j + 1
 
    Loop
 
End Sub

c'est donc a peu près résolu ! je vais essayer d'isoler les segments qui auront split et transposé en insérant une ligne (avant et après si possible...)

Merci pour votre contribution !!!

[Pierre Fauconnier]

Chouette solution... que je n'aime pas trop...

Mes règles de pratique informatique m'interdisent de toucher aux données d'entrée. Le respect de cette règle me permet de repartir "à zéro" en cas de pépin. C'est pour moi une règle de base dans le traitement des données.

je ne sais pas combien de lignes tu auras à traiter finalement, mais j'ai fait le test avec un échantillon de 1000 lignes. Le code avec l'array dynamique est instantané (moins de 0.5 seconde), le tien, sur 1000 lignes, met 16 secondes. J'ai fait le test avec 10.000 lignes. Celui que je propose met toujours moins de 0.5 seconde, le tien met 3:18...

Ton code copie les formats et toutes les propriétés des cellules, ce qui ralentit d'autant le traitement. De plus, repousser autant de fois les lignes vers le bas est coûteux en temps de traitement car tu fais travailler ton environnement Excel. Tu gagnerais un peu, si tu gardes ta solution, à placer Application.ScreenUpdating = false en début de macro et à désactiver le calcul manuel, propriétés que tu rétabliras bien évidemment en fin de macro.


D'une façon générale, je dis qu'il faut d'abord penser Excel avant de penser VBA, mais il y a évidemment des exceptions, et le traitement de grandes plages de données en est une...

[Arthursl]

Bonjour Pierre, Bonjour le Forum,

Oui je comprends totallement, j'essaierai de l'améliorer avec cette formule pour optimiser le temps de réponse de ma formule...

Je prends aussi note de ta règle du respect des données d'entrée qui sera sûrement utile à l'avenir

Merci pour ton aide !

[MarcelG]

Bonjour Arthur et Pierre, Bonjour le Forum,

Une autre proposition.

Si l'on dispose d'une fonction utilitaire (classique) retournant la compilation de 2 variables Tableau en 1 Tableau, alors il suffit de créer un Tableau pour chaque item, et de compiler les tableaux obtenus en boucle.

En effet, par cette fonction,
Comme on écrit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

n = n+1

Ici

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

tblo_final = SumTablo(T, tblo_final)

La fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Function SumTablo(T_Init As Variant, T_ajout As Variant) As Variant
 
Dim ArrayCum As Variant
 
Dim i As Integer, j As Integer, k As Integer
 
k = 0
 
ReDim ArrayCum(0 To UBound(T_Init, 1), 0 To UBound(T_Init, 2) + UBound(T_ajout, 2) + 1)
 
For i = 0 To UBound(T_Init, 1)
        For j = 0 To UBound(T_Init, 2)
                ArrayCum(i, j) = T_Init(i, j)
        Next j
        For j = UBound(T_Init, 2) + 1 To UBound(ArrayCum, 2)
                ArrayCum(i, j) = T_ajout(i, k)
                k = k + 1
        Next j
        k = 0
Next i
 
SumTablo = ArrayCum
 
End Function

Partant, la procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Option Explicit
 
Sub SplitSerialNumbers_Marcel()
 
ReDim tblo_final(0 To 1, 0 To 0)
 
tblo_final(0, 0) = ""
tblo_final(1, 0) = ""
 
Dim T() As Variant
Dim valtablo As Variant, Temp As Variant
Dim i As Long, j As Long
Dim n As Double
Dim p As Variant
 
With ThisWorkbook.Worksheets(1)
 
        .Range("E2:F60").ClearContents
 
        For i = .Range("T_Base[MATOS]").Count To 1 Step -1
 
                ReDim T(0 To 1, 0 To 0)
 
                p = .Range("T_Base[MATOS]").Cells(i, 1).Value
                Temp = Split(p, "-")
 
                n = -1
 
                For j = LBound(Temp) To UBound(Temp)
 
                        n = n + 1
                        ReDim Preserve T(0 To 1, 0 To n)
 
                        T(0, n) = .Range("T_Base[id]").Cells(i, 1).Value
                        T(1, n) = Temp(j)
 
                Next j
 
                tblo_final = SumTablo(T, tblo_final)
 
                Erase T
 
        Next i
 
        'Suppression du tableau initial tblo_final vide
        ReDim Preserve tblo_final(0 To UBound(tblo_final, 1), 0 To UBound(tblo_final, 2) - 1)
 
        'For i = LBound(tblo_final, 1) To UBound(tblo_final, 1)
        '       For j = LBound(tblo_final, 2) To UBound(tblo_final, 2)
        '               Debug.Print i & " / " & j & " / " & tblo_final(i, j)
        '       Next j
        'Next i
 
        'Debug.Print .Range("K2").Resize(UBound(tblo_final, 2) + 1, UBound(tblo_final, 1) + 1).Address
 
        .Range("E2").Resize(UBound(tblo_final, 2) + 1, UBound(tblo_final, 1) + 1).Value = Application.WorksheetFunction.Transpose(tblo_final)
 
End With
 
End Sub

(A adapter bien entendu, notamment au niveau séparateur "-")

Le résultat



La fonction SumTablo peut être réutilisable (Je la conserve dans mes utilitaires).
Pour ma part, la procédure s'en trouve alors simplifiée.

[Arthursl]

Bonjour Marcel, Bonjour Pierre,
Bonjour le Forum.

Merci pour ton autre solution qui est aussi intéressante, je vais réécrire ma macro plus tard lorque je ferai une mise à jour de celle-ci en suivant vos conseil respectif afin d'optimiser son utilisation

Merci encore pour votre aide à vous deux

Arthur

[MarcelG]

Bonjour Arthur, Bonjour le Forum,

Procédure simplifiée.
+ Reversement sur tableau structuré (Y'a plus End(xlUp) )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Option Explicit
 
Sub SplitSerialNumbers_Marcel()
 
ReDim tblo_final(0 To 1, 0 To 0)
 
Dim T() As Variant
Dim valtablo As Variant, Temp As Variant
Dim i As Long, j As Long
Dim n As Double
Dim p As Variant
 
With ThisWorkbook.Worksheets(1)
 
       .Range("T_Résultat").ListObject.DataBodyRange.Delete
 
        For i = 1 To .Range("T_Base[MATOS]").Count
 
                ReDim T(0 To 1, 0 To 0)
 
                p = .Range("T_Base[MATOS]").Cells(i, 1).Value
                Temp = Split(p, "-")
 
                n = -1
 
                For j = LBound(Temp) To UBound(Temp)
 
                        n = n + 1
                        ReDim Preserve T(0 To 1, 0 To n)
 
                        T(0, n) = .Range("T_Base[id]").Cells(i, 1).Value
                        T(1, n) = Temp(j)
 
                Next j
 
                If i = 1 Then
                        tblo_final = T
                Else
                        tblo_final = SumTablo(tblo_final, T)
                End If
 
                Erase T
 
        Next i
 
        .Range("T_Résultat[ID]").Cells(1, 1).Resize(UBound(tblo_final, 2) + 1, UBound(tblo_final, 1) + 1).Value = Application.WorksheetFunction.Transpose(tblo_final)
 
End With
 
End Sub

La fonction SumTablo, quant à elle, reste inchangée.

Bonne semaine à tous.