Séparer plusieurs données d'une cellule puis les insérer en colonne en décalant les lignes du bas

**Pantoulfe** · 12/02/2019, 15h14

Bonjour à tous,

Tout d’abord, je n’ai pas une grande connaissance de VBA. J'essaye au maximum de me renseigner et ensuite de commenter mon code pour bien le comprendre.
Ma demande est faisable sans macro mais très longuueeeee, car je dois faire la manip dans plusieurs classeurs qui eux-mêmes possèdent plusieurs onglets.

Actuellement :
Je lance une série de test sur un logiciel avec mes classeurs. Le logiciel rempli mes classeurs par rapport aux données du test (de « A » à « O » dans les xls) puis celui-ci me renvoi des KO ou OK. Si j'ai un KO, je dois regarder toutes les données des cellules de la colonne «P» et «Q» et les analyser.
Je souhaite modifier mes classeurs car actuellement c'est très fastidieux de contrôler le contenu des cellules. Je le fais manuellement et ça me prend un temps considérable.

Le but de ma demande :
Mettre une SEUL donnée dans la colonne P et Q. Je pourrais me rendre compte directement qu'elle est la donnée qui est KO avec un simple filtre MAIS pour cela je dois convertir mes classeurs et c’est cette démarche que je souhaite faire avec vous.
Si une macro pouvait me créer mon nouveau onglet, ça serait formidable.

Mon classeur actuel : Dans un onglet, celui
Contient en P14 : PC02/SRSW/P442/P60G/PR5E/PR2E
Contient en Q14 : PRO-PR2E/PRO-PR10/PRO-SWBV-00/PRO-SPM1-00/PRO-SPM1-01
Contient en P15 : S485/S672/S106/S34P/P140/P14B/PC00/PC01/P64C/S4GL
Contient en Q15 : PRO-SPR2-01/PRO-SRMC-00/PRO-PRF5-00/PRO-SW3S-00
Et ainsi de suite (jusqu’à la dernière ligne).

J'ai donc une ligne pour faire les tests des éléments en P14 et Q14. Idem pour P15 et Q15.
Les données dans ses cellules sont rarement identiques et peuvent parfois contenir 100 éléments séparer par "/".
Aussi, les cellules en P ou Q et ne peuvent être toutes les deux vides en même temps sur la même ligne MAIS l'une ou l'autre peuvent être vide.

Concernant les colonnes précédentes (A14, B14 etc..), il y a des données et c'est son contenu qui me permet de réaliser des tests. Ensuite en P14 et Q14 c’est l’attendu.
Info : j’ai pris P, mais le fichier commence en ligne A. Désolé pour la confusion.

Ma problématique actuelle :
Je souhaiterais séparer les données de la cellule en P14 puis les mettre les un à la suite de autre à partir de la colonne P14.
Mon souci, c'est qu'actuellement il y a des éléments en P14, en P15, P16 et ainsi de suite donc à chaque fois, il faut décaler d'autant de lignes que possède d'élément la cellule "P" ou "Q".

Mon souhait:
Il faudrait que ma cellule P14 (Q14 est vide) contienne seulement PC02, puis:
P15 - SRSW (Q15 est vide)
P16 - P442 (Q16 est vide)
P17 - P60G (Q17 est vide)
P18 - PR5E (Q18 est vide)
P19 - PR2E (Q19 est vide)

Puis on bascule sur les données en Q20 :
Q20 - PRO-PR2E (P20 est vide)
Q21 - PRO-PR10 (P21 est vide)
Q22 - PRO-SWBV-00 (P22 est vide)
Q23 - PRO-SPM1-00 (P23 est vide)
Q24 - PRO-SPM1-01 (P24 est vide)

Et ainsi de suite
J'ai donc créé 10 lignes pour faire les tests des éléments qui se trouvaient en P14 et Q14.
Concernant les colonnes précédentes (A14, B14 etc..), il faudra dupliquer les contenus pour correspondre aux tests.

L'exemple en image de l'avant modification:
Nom : donneesOrigine_A14-Q14.PNG
Affichages : 749
Taille : 32,1 Ko

Nom : donneesOrigine_A14-Q14.PNG
Affichages : 749
Taille : 32,1 Ko

Info: sur l'image, les données sont renvoyer à la ligne automatiquement

L'exemple en image de l'après :
Nom : donneesTransforme_A14-Q14.PNG
Affichages : 764
Taille : 35,2 Ko

Nom : donneesTransforme_A14-Q14.PNG
Affichages : 764
Taille : 35,2 Ko

Info: sur l'image, les données sont renvoyer à la ligne automatiquement

Ensuite à partir de P25, je commence à insérer les éléments de P15

J’espère avoir été clair.
Au besoin, je peux vous fournir un fichier réduit.
Merci pour votre aide.

**Kimy_Ire** · 12/02/2019, 18h05

Bonjour Pantoufle (j'adore ton pseudo

),

Voici une procédure écrite rapidement qui répond partiellement à ton besoin :

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
Option Explicit
'Colonne P
Const colP = 16
'Définition de la ligne de départ
Const oLign = 3
 
Sub Decomposition()
Dim oRng As Range
Dim i As Integer, j As Integer
Dim oTableP() As String
Dim oTableQ() As String
 
With Worksheets("MaFeuil")
    Set oRng = .Cells(Rows.Count, colP).End(xlUp)
 
    Do
        oTableP = Split(oRng.Offset(0, 0), "/")
        oTableQ = Split(oRng.Offset(0, 1), "/")
 
        oRng.Offset(0, 0) = oTableP(LBound(oTableP))
        oRng.Offset(0, 1) = ""
        For i = LBound(oTableP) + 1 To UBound(oTableP)
            oRng.Offset(i, 0).EntireRow.Insert
            oRng.Offset(i, 0) = oTableP(i)
            'TODO : recopier les valeurs de la ligne
        Next i
 
        For j = LBound(oTableQ) To UBound(oTableQ)
            oRng.Offset(i + j, 0).EntireRow.Insert
            oRng.Offset(i + j, 1) = oTableQ(j)
            'TODO : recopier les valeurs de la ligne
        Next j
 
        Set oRng = oRng.Offset(-1, 0)
    Loop Until oRng.Row < oLign
 
 
End With
 
End Sub

Quelques précisions :

je suis parti du principe que tu voulais faire tes décompositions de la ligne 14 à la dernière ligne non-vide de ta colonne P (dans mon exemple ligne 3),
de fait - par soucis de simplicité pour ne pas me perdre dans des compteurs infernaux - je commence par décomposer la dernière ligne et remonte jusqu'à la ligne 14,
je n'ai pas fait la recopie de toutes les cellules de chacune de tes lignes (je verrais si je m'y penche demain) - cf. TODO.

Selon ma compréhension de ta demande, ça fonctionne bien chez moi.

Je te laisse faire des essais de ton côté.

N'hésite pas à revenir vers moi.

Kimy

**Algoplus** · 12/02/2019, 18h32

bonjour à tous,

un essai à tester:

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
Sub EclatePQ()
Dim i As Long, T1, T2, TT1 As Integer, TT2 As Integer, TT As Integer
 For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1 'adapter le 2 au N°ligne débutant les données
    T1 = Split(Cells(i, 16), "/") 'données de P séparées dans un tableau
    T2 = Split(Cells(i, 17), "/") 'données de Q séparées dans un tableau
    TT1 = UBound(T1) + 1
    TT2 = UBound(T2) + 1
    TT = TT1 + TT2
    Rows(i).Copy
    Rows(i + 1).Resize(TT - 1).Insert xlShiftDown 'insertion autant de ligne que de valeurs en P et Q
    Range("P" & i & ":Q" & i + TT - 1).ClearContents 'effacement des cellules P et Q des lignes insérées
    Range("P" & i).Resize(TT1, 1) = Application.Transpose(T1) 'copie des des données séparées en P
    Range("Q" & i + TT1).Resize(TT2, 1) = Application.Transpose(T2) ''copie des des données séparées en Q
 Next
End Sub

pour bien faire, il faudrait "rattacher" tous les cells et range à la feuille concernée (with worksheets("Nom de feuille") comme l'a fait Kimy_Ire

A+

**Pantoulfe** · 12/02/2019, 20h39

Merci pour vos réponse Kimy_Ire & Algoplus. Vous êtes au top.
Je regarde ça dans la soirée et je vous tiens au courant.

Edite : Bien vu pour le "EclatePQ" Algoplus :-)

**Kimy_Ire** · 13/02/2019, 10h06

Bonjour à tous les deux,

Avec la recopie des lignes :

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
Option Explicit
'Colonne P
Const colP = 16
'Définition de la ligne de départ
Const oLign = 3
 
Sub Decomposition()
Dim oRng As Range
Dim i As Integer, j As Integer, k As Integer
Dim oTableP() As String
Dim oTableQ() As String
 
With Worksheets("MaFeuil")
    Set oRng = .Cells(Rows.Count, colP).End(xlUp)
 
    Do
        oTableP = Split(oRng.Offset(0, 0), "/")
        oTableQ = Split(oRng.Offset(0, 1), "/")
 
        oRng.Offset(0, 0) = oTableP(LBound(oTableP))
        oRng.Offset(0, 1) = ""
        For i = LBound(oTableP) + 1 To UBound(oTableP)
            oRng.Offset(i, 0).EntireRow.Insert
            oRng.Offset(i, 0) = oTableP(i)
            Range(.Cells(oRng.Offset(i, 0).Row, 1), .Cells(oRng.Offset(i, 0).Row, colP - 1)).Value = _
            Range(.Cells(oRng.Offset(i, 0).Row - 1, 1), .Cells(oRng.Offset(i, 0).Row - 1, colP - 1)).Value
        Next i
 
        For j = LBound(oTableQ) To UBound(oTableQ)
            oRng.Offset(i + j, 0).EntireRow.Insert
            oRng.Offset(i + j, 1) = oTableQ(j)
            Range(.Cells(oRng.Offset(i + j, 0).Row, 1), .Cells(oRng.Offset(i + j, 0).Row, colP - 1)).Value = _
            Range(.Cells(oRng.Offset(i + j, 0).Row - 1, 1), .Cells(oRng.Offset(i + j, 0).Row - 1, colP - 1)).Value
        Next j
 
        Set oRng = oRng.Offset(-1, 0)
    Loop Until oRng.Row < oLign
 
End With
 
End Sub

D'après ma compréhension, ca fonctionne bien.

Restant à ta dispo.

Kimy

**Pantoulfe** · 13/02/2019, 12h48

Hello @Kimy_Ire & @Algoplus,
j’espère que vous allez bien.

Je viens de tester.
sauf erreur de ma part, cela ne fonctionne pas.

Nom : Erreur_execution.PNG
Affichages : 714
Taille : 4,2 Ko

Nom : Erreur_execution.PNG
Affichages : 714
Taille : 4,2 Ko

Nom : Erreur_execution_v1bis.PNG
Affichages : 722
Taille : 31,0 Ko

J'ai testé aussi l'autre :
Nom : Erreur_execution_v2.PNG
Affichages : 700
Taille : 4,2 Ko

Nom : Erreur_execution_v2bis.PNG
Affichages : 710
Taille : 22,5 Ko

A prendre en compte.
Je ne comprends pas forcement tout ce que je lis donc n’hésitez pas a commenté un maximum, si possible.

Merci d'avance à tous les deux.

**patricktoulon** · 13/02/2019, 13h30

re
bonjour pas sur d'avoir compris mais je tente un essai

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub test()
  Dim i&, tabl
  For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        tabl = Split(Cells(i, "P"), "/")
        If UBound(tabl) > 0 Then
            Rows(i + 1).Resize(UBound(tabl) + 1).Insert
            Cells(i + 1, "Q").Resize(UBound(tabl) + 1) = Application.Transpose(tabl)
            Cells(i, "p") = tabl(0)
            Cells(i + 1, "p").EntireRow.Delete
        End If
    Next i
End Sub

Nom : demo3.gif
Affichages : 690
Taille : 228,4 Ko

**Kimy_Ire** · 13/02/2019, 15h22

Ma première intuition : je dirais que tu n'as pas lu mes suppositions énoncées dans ma première réponse.
Je te laisse en prendre connaissance et me dire si elles sont justes ou pas...

Je t'envoie le code commenté :

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
Option Explicit
'Colonne P
Const colP = 16
'Définition de la ligne de départ
Const oLign = 3
 
Sub Decomposition()
'Déclaration des variables
Dim oRng As Range
Dim i As Integer, j As Integer, k As Integer
Dim oTableP() As String
Dim oTableQ() As String
 
'Avec la feuille cible
With Worksheets("MaFeuil")
    'Je set oRng sur la dernière ligne non vide de la colonne P
    '/!\ Je considère que je dois traiter toutes les lignes à partir de 3 (ici dans l'exemple) jusqu'à la dernière ligne non-vide de la colonne.
    Set oRng = .Cells(Rows.Count, colP).End(xlUp)
 
    'Boucle en "remontant"
    Do
        'Je split mes cellules Px et Qx
        'Dans mes tableaux oTableP et oTableQ, j'aurais des valeurs -ex : {PC02 ; SRSW ; P442 ; P60G ; PR5E ; PR2E}
        oTableP = Split(oRng.Offset(0, 0), "/")
        oTableQ = Split(oRng.Offset(0, 1), "/")
 
        'Je met dans ma cellule Px la première valeur de ma oTableP
        oRng.Offset(0, 0) = oTableP(LBound(oTableP))
        'Et dans ma Qx, je supprime la valeur
        oRng.Offset(0, 1) = ""
 
        'Je boucle de la deuxième valeur de ma oTableP à la dernière valeur (la première valeur ayant déjà été insérée préalablement)
        For i = LBound(oTableP) + 1 To UBound(oTableP)
            'J'insère une ligne en dessous
            oRng.Offset(i, 0).EntireRow.Insert
            'J'y ajoute la valeur de oTableP(i)
            oRng.Offset(i, 0) = oTableP(i)
            'et je recopie l'intégralité de la ligne
            Range(.Cells(oRng.Offset(i, 0).Row, 1), .Cells(oRng.Offset(i, 0).Row, colP - 1)).Value = _
            Range(.Cells(oRng.Offset(i, 0).Row - 1, 1), .Cells(oRng.Offset(i, 0).Row - 1, colP - 1)).Value
        Next i
 
        'Je fais à peu près pareil pour ma oTableQ
        'je boucle simplement sur l'ensemble du tableau
        For j = LBound(oTableQ) To UBound(oTableQ)
            oRng.Offset(i + j, 0).EntireRow.Insert
            oRng.Offset(i + j, 1) = oTableQ(j)
            Range(.Cells(oRng.Offset(i + j, 0).Row, 1), .Cells(oRng.Offset(i + j, 0).Row, colP - 1)).Value = _
            Range(.Cells(oRng.Offset(i + j, 0).Row - 1, 1), .Cells(oRng.Offset(i + j, 0).Row - 1, colP - 1)).Value
        Next j
 
        'Et enfin je décale ma Range à la ligne du dessus pour remonter tranquillement jusqu'à la condition de fin (ici = 3)
        Set oRng = oRng.Offset(-1, 0)
    Loop Until oRng.Row < oLign
 
End With
 
End Sub

@patricktoulon : il y a une subtilité de plus - prise en compte de la colonne Q dans laquelle tu peux aussi avoir des valeurs.

Kimy

**Algoplus** · 13/02/2019, 16h43

l'erreur provient des lignes où P et Q sont vides.
La correction avec P et/ou Q vide.

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
Sub EclatePQ()
Dim i As Long, T1, T2, TT1 As Integer, TT2 As Integer, TT As Integer
 For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1 'adapter le 2 au N°ligne débutant les données
    'MsgBox i
    T1 = Split(Cells(i, 16), "/") 'données de P séparées dans un tableau
    T2 = Split(Cells(i, 17), "/") 'données de Q séparées dans un tableau
    TT1 = UBound(T1) + 1
    TT2 = UBound(T2) + 1
    TT = TT1 + TT2
    If TT > 0 Then
        Rows(i).Copy
        Rows(i + 1).Resize(TT - 1).Insert xlShiftDown 'insertion autant de ligne que de valeurs en P et Q
        Range("P" & i & ":Q" & i + TT - 1).ClearContents 'effacement des cellules P et Q des lignes insérées
        If TT1 > 0 Then Range("P" & i).Resize(TT1, 1) = Application.Transpose(T1)            'copie des des données séparées en P
        If TT2 > 0 Then Range("Q" & i + TT1).Resize(TT2, 1) = Application.Transpose(T2) ''copie des des données séparées en Q
    End If
 Next
End Sub

A+

**Pantoulfe** · 13/02/2019, 17h01

Envoyé par Kimy_Ire

Ma première intuition : je dirais que tu n'as pas lu mes suppositions énoncées dans ma première réponse.
Je te laisse en prendre connaissance et me dire si elles sont justes ou pas...
Kimy

Pour être sincère, je l'ai lu quand tu as posté ton message mais je l'ai oublié quand j'ai fais mes tests (le lendemain). Toutes mes excuses Kimy pour la perte de temps.

Envoyé par Kimy_Ire

Quelques précisions :
je suis parti du principe que tu voulais faire tes décompositions de la ligne 14 à la dernière ligne non-vide de ta colonne P (dans mon exemple ligne 3),(...)

Oui c'est exacte. De la ligne P14 à la dernière ligne non vide donc P198.
D'ailleurs, pour être ISO avec cet onglet, les données à split commence à la ligne 4 et finissent à 198 MAIS j'ai indiqué ligne 14 car les premières lignes (P ou Q) possédaient une seule donnée.
Toutefois, selon les classeurs et onglets c'est différent

Envoyé par Kimy_Ire

(...) de fait - par soucis de simplicité pour ne pas me perdre dans des compteurs infernaux - je commence par décomposer la dernière ligne et remonte jusqu'à la ligne 14,(...)

Donc, tu veux dire que par soucis de simplicité, la macro fait par ordre décroissant. 198, 197, 196 jusqu'à 14 ?

Du coup, après relecture de ta partie "précisions" j'ai testé de nouveau :-).

Sauf erreur de ma part, ton code ne me fait plus d'erreur, MAIS,
il ne termine pas l’opération intégralement.
je pense qu'il manque la gestion :
- de quand il n'y a pas de "/"
c'est à dire que parfois, il y a un seul élément sans "/" du coup la macro s’arrête.

Envoyé par Kimy_Ire

Quelques précisions :
(...)je n'ai pas fait la recopie de toutes les cellules de chacune de tes lignes (je verrais si je m'y penche demain) - cf. TODO.(...)

Et merci pour avoir implémenté la copie des lignes.

**Pantoulfe** · 13/02/2019, 17h36

J'ai mis 3 heures pour écrire mon message juste en haut... Satané boulot 😄.

Envoyé par Algoplus

l'erreur provient des lignes où P et Q sont vides.
La correction avec P et/ou Q vide.

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
Sub EclatePQ()
Dim i As Long, T1, T2, TT1 As Integer, TT2 As Integer, TT As Integer
 For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1 'adapter le 2 au N°ligne débutant les données
    'MsgBox i
    T1 = Split(Cells(i, 16), "/") 'données de P séparées dans un tableau
    T2 = Split(Cells(i, 17), "/") 'données de Q séparées dans un tableau
    TT1 = UBound(T1) + 1
    TT2 = UBound(T2) + 1
    TT = TT1 + TT2
    If TT > 0 Then
        Rows(i).Copy
        Rows(i + 1).Resize(TT - 1).Insert xlShiftDown 'insertion autant de ligne que de valeurs en P et Q
        Range("P" & i & ":Q" & i + TT - 1).ClearContents 'effacement des cellules P et Q des lignes insérées
        If TT1 > 0 Then Range("P" & i).Resize(TT1, 1) = Application.Transpose(T1)            'copie des des données séparées en P
        If TT2 > 0 Then Range("Q" & i + TT1).Resize(TT2, 1) = Application.Transpose(T2) ''copie des des données séparées en Q
    End If
 Next
End Sub

A+

Merci pour la correction.
Je test demain.

**Kimy_Ire** · 13/02/2019, 17h59

J'ai mis au point. Je n'avais pas pris en compte certains paramètres comme le vide et le sans "/".

J'ai bidouillé... Il y a beaucoup plus propre, mais ça fonctionne.

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Option Explicit
'Colonne P
Const colP = 16
'Définition de la ligne de départ
Const oLign = 3
 
Sub Decomposition()
'Déclaration des variables
Dim oRng As Range
Dim i As Integer, j As Integer, k As Integer
Dim oTableP() As String
Dim oTableQ() As String
Dim boolP As Boolean
 
'Avec la feuille cible
With Worksheets("MaFeuil")
    'Je set oRng sur la dernière ligne non vide de la colonne P
    Set oRng = .Cells(WorksheetFunction.Max(.Cells(Rows.Count, colP).End(xlUp).Row, .Cells(Rows.Count, colP + 1).End(xlUp).Row), colP)
 
    'Boucle en "remontant"
    Do
        boolP = False
        'Je split mes cellules Px et Qx
        'Dans mes tableaux oTableP et oTableQ, j'aurais des valeurs -ex : {PC02 ; SRSW ; P442 ; P60G ; PR5E ; PR2E}
        If InStr(oRng, "/") Then
            oTableP = Split(oRng.Offset(0, 0), "/")
            boolP = True
 
            'Je met dans ma cellule Px la première valeur de ma oTableP
            oRng.Offset(0, 0) = oTableP(LBound(oTableP))
 
            'Je boucle de la deuxième valeur de ma oTableP à la dernière valeur (la première valeur ayant déjà été insérée préalablement)
            For i = LBound(oTableP) + 1 To UBound(oTableP)
                'J'insère une ligne en dessous
                oRng.Offset(i, 0).EntireRow.Insert
                'J'y ajoute la valeur de oTableP(i)
                oRng.Offset(i, 0) = oTableP(i)
                'et je recopie l'intégralité de la ligne
                Range(.Cells(oRng.Offset(i, 0).Row, 1), .Cells(oRng.Offset(i, 0).Row, colP - 1)).Value = _
                Range(.Cells(oRng.Offset(i, 0).Row - 1, 1), .Cells(oRng.Offset(i, 0).Row - 1, colP - 1)).Value
            Next i
        End If
 
        If InStr(oRng.Offset(0, 1), "/") Then
            oTableQ = Split(oRng.Offset(0, 1), "/")
 
            'Et dans ma Qx, je supprime la valeur
            oRng.Offset(0, 1) = ""
 
            If boolP Then
                oRng.Offset(i, 0).EntireRow.Insert
                oRng.Offset(i, 1) = oTableQ(LBound(oTableQ))
                Range(.Cells(oRng.Offset(i, 0).Row, 1), .Cells(oRng.Offset(i, 0).Row, colP - 1)).Value = _
                Range(.Cells(oRng.Offset(i, 0).Row - 1, 1), .Cells(oRng.Offset(i, 0).Row - 1, colP - 1)).Value
            Else
                i = 0
                oRng.Offset(0, 1) = oTableQ(LBound(oTableQ))
            End If
 
            'Je fais à peu près pareil pour ma oTableQ
            'je boucle simplement sur l'ensemble du tableau
            For j = LBound(oTableQ) + 1 To UBound(oTableQ)
                oRng.Offset(i + j, 0).EntireRow.Insert
                oRng.Offset(i + j, 1) = oTableQ(j)
                Range(.Cells(oRng.Offset(i + j, 0).Row, 1), .Cells(oRng.Offset(i + j, 0).Row, colP - 1)).Value = _
                Range(.Cells(oRng.Offset(i + j, 0).Row - 1, 1), .Cells(oRng.Offset(i + j, 0).Row - 1, colP - 1)).Value
            Next j
        End If
 
        'Et enfin je décale ma Range à la ligne du dessus pour remonter tranquillement jusqu'à la condition de fin (ici = 3)
        Set oRng = oRng.Offset(-1, 0)
    Loop Until oRng.Row < oLign
 
End With
 
End Sub

Je te laisse tester.

Kimy

**Pantoulfe** · 14/02/2019, 08h49

@patricktoulon:
Merci pour ta proposition.
Comme la précisé Kimy, il y a une subtilité supplémentaire.

@Algoplus:
Toujours la même erreur

@Kimy_Ire
Tout à l'heure de fonctionner.
En tout cas, la macro fait le taff.
Déjà pour ça : MERCI BEAUCOUP !

Ensuite 1 petit truc :
Dans mes lignes de test, en colonne F, il y a un "false" ou "true"
et je ne sais pas pourquoi mais quand il copie la ligne de A à O : "false" est traduit en "FAUX"
Par ailleurs, étrangement, il garde la première ligne en "false", puis quand il décale les autres données à la suite en bas, il met " FAUX".
J'ai l'impression que ça vient de mon Excel ?

Bonus : En dehors d'un message qui m'annoncerait que le split est fini, existe-t-il un système qui afficherait le temps qui reste à la macro pour finir le taff ? (juste un simple oui ou non, et ou une piste)

ET MERCI A TOUS LES 3 POUR VOS PROPOSITIONS.
Qu'est ce qu'on ferait sans vous franchement ?

**Kimy_Ire** · 14/02/2019, 09h52

Salut Pantoufle,

Ravi !

Concernant tes deux points :

Cette ligne

Code :

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

1
2
                Range(.Cells(oRng.Offset(i, 0).Row, 1), .Cells(oRng.Offset(i, 0).Row, colP - 1)).Value = _
                Range(.Cells(oRng.Offset(i, 0).Row - 1, 1), .Cells(oRng.Offset(i, 0).Row - 1, colP - 1)).Value

recopie les valeurs des Ranges de la colonne 1 à la colonne précédent la colP.
De fait, Excel va interpréter la valeur "false" en "FAUX". Regarde sur le net si il y a moyen de ne pas interpréter les valeurs.

Faire un timer en VBA est à la fois simple et compliqué.
Par contre, sil s'agit d'accélérer la macro, cela peut se faire aisément avec en début :

Code :

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

1
2
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

et en fin :

Code :

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

1
2
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

En revanche, attention si la macro plante au milieu, il s'agira de faire passer uniquement les deux dernières lignes de code.

A ta dipo.

Kimy

**Pantoulfe** · 14/02/2019, 10h34

Envoyé par Kimy_Ire

Salut Pantoufle,

Ravi !

Grave ! :-)

Envoyé par Kimy_Ire

Concernant tes deux points :
[LIST=1][*]Cette ligne

Code :

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

1
2
3
 
Range(.Cells(oRng.Offset(i, 0).Row, 1), .Cells(oRng.Offset(i, 0).Row, colP - 1)).Value = _
Range(.Cells(oRng.Offset(i, 0).Row - 1, 1), .Cells(oRng.Offset(i, 0).Row - 1, colP - 1)).Value

recopie les valeurs des Ranges de la colonne 1 à la colonne précédent la colP.
De fait, Excel va interpréter la valeur "false" en "FAUX". Regarde sur le net si il y a moyen de ne pas interpréter les valeurs.

Apres recherche.
Si je passe la colonne F (celle qui pose probléme) en format "TEXTE", alors la copie ne change pas en "FAUX", du coup, je recherche le code qui va me permettre cela.
je devrais pouvoir trouver ça.

Envoyé par Kimy_Ire

[*]Faire un timer en VBA est à la fois simple et compliqué.
Par contre, sil s'agit d'accélérer la macro, cela peut se faire aisément avec en début :

Code :

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

1
2
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Je ne suis pas sur de comprendre ou cela va aller exactement, mais je vais chercher. je devrais pouvoir trouver.
C'est un fichier de test donc je vais tester avec et sans ce bout de code ^^

Envoyé par Kimy_Ire

et en fin :

Code :

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

1
2
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

En revanche, attention si la macro plante au milieu, il s'agira de faire passer uniquement les deux dernières lignes de code.

La, tu m'as perdu ^^

Je passe ma demande en Résolu. Vous avez déjà fait beaucoup pour moi.
Vous êtes au top ! Et surtout ne changer rien !

**Kimy_Ire** · 14/02/2019, 13h01

Pour faire simple :

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Option Explicit
'Colonne P
Const colP = 16
'Définition de la ligne de départ
Const oLign = 3
 
Sub Decomposition()
'Déclaration des variables
Dim oRng As Range
Dim i As Integer, j As Integer, k As Integer
Dim oTableP() As String
Dim oTableQ() As String
Dim boolP As Boolean
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
'Avec la feuille cible
With Worksheets("MaFeuil")
    'Je set oRng sur la dernière ligne non vide de la colonne P
    Set oRng = .Cells(WorksheetFunction.Max(.Cells(Rows.Count, colP).End(xlUp).Row, .Cells(Rows.Count, colP + 1).End(xlUp).Row), colP)
 
    'Boucle en "remontant"
    Do
        boolP = False
        'Je split mes cellules Px et Qx
        'Dans mes tableaux oTableP et oTableQ, j'aurais des valeurs -ex : {PC02 ; SRSW ; P442 ; P60G ; PR5E ; PR2E}
        If InStr(oRng, "/") Then
            oTableP = Split(oRng.Offset(0, 0), "/")
            boolP = True
 
            'Je met dans ma cellule Px la première valeur de ma oTableP
            oRng.Offset(0, 0) = oTableP(LBound(oTableP))
 
            'Je boucle de la deuxième valeur de ma oTableP à la dernière valeur (la première valeur ayant déjà été insérée préalablement)
            For i = LBound(oTableP) + 1 To UBound(oTableP)
                'J'insère une ligne en dessous
                oRng.Offset(i, 0).EntireRow.Insert
                'J'y ajoute la valeur de oTableP(i)
                oRng.Offset(i, 0) = oTableP(i)
                'et je recopie l'intégralité de la ligne
                Range(.Cells(oRng.Offset(i, 0).Row, 1), .Cells(oRng.Offset(i, 0).Row, colP - 1)).Value = _
                Range(.Cells(oRng.Offset(i, 0).Row - 1, 1), .Cells(oRng.Offset(i, 0).Row - 1, colP - 1)).Value
            Next i
        End If
 
        If InStr(oRng.Offset(0, 1), "/") Then
            oTableQ = Split(oRng.Offset(0, 1), "/")
 
            'Et dans ma Qx, je supprime la valeur
            oRng.Offset(0, 1) = ""
 
            If boolP Then
                oRng.Offset(i, 0).EntireRow.Insert
                oRng.Offset(i, 1) = oTableQ(LBound(oTableQ))
                Range(.Cells(oRng.Offset(i, 0).Row, 1), .Cells(oRng.Offset(i, 0).Row, colP - 1)).Value = _
                Range(.Cells(oRng.Offset(i, 0).Row - 1, 1), .Cells(oRng.Offset(i, 0).Row - 1, colP - 1)).Value
            Else
                i = 0
                oRng.Offset(0, 1) = oTableQ(LBound(oTableQ))
            End If
 
            'Je fais à peu près pareil pour ma oTableQ
            'je boucle simplement sur l'ensemble du tableau
            For j = LBound(oTableQ) + 1 To UBound(oTableQ)
                oRng.Offset(i + j, 0).EntireRow.Insert
                oRng.Offset(i + j, 1) = oTableQ(j)
                Range(.Cells(oRng.Offset(i + j, 0).Row, 1), .Cells(oRng.Offset(i + j, 0).Row, colP - 1)).Value = _
                Range(.Cells(oRng.Offset(i + j, 0).Row - 1, 1), .Cells(oRng.Offset(i + j, 0).Row - 1, colP - 1)).Value
            Next j
        End If
 
        'Et enfin je décale ma Range à la ligne du dessus pour remonter tranquillement jusqu'à la condition de fin (ici = 3)
        Set oRng = oRng.Offset(-1, 0)
    Loop Until oRng.Row < oLign
 
End With
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
End Sub

Et si un jour ton code plante au milieu :

Code :

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

1
2
3
4
5
6
Sub reset()
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
End Sub

Voila !

Kimy

Séparer plusieurs données d'une cellule puis les insérer en colonne en décalant les lignes du bas [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager