Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

passage cellule en dessous


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    passage cellule en dessous
    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 !

  2. #2
    Expert éminent
    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.

    Bien Cordialement.

    Marcel

    Dernier billet:
    Suppression des doublons d'un tableau structuré, gestion d'un array

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.


  3. #3
    Expert éminent
    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

    Bien Cordialement.

    Marcel

    Dernier billet:
    Suppression des doublons d'un tableau structuré, gestion d'un array

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.


  4. #4
    Membre à l'essai
    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 !

  5. #5
    Expert éminent
    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

    Bien Cordialement.

    Marcel

    Dernier billet:
    Suppression des doublons d'un tableau structuré, gestion d'un array

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.


  6. #6
    Responsable
    Office & Excel

    Salut.

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

    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    Vous avez apprécié la réponse? =>
    ---------------

  7. #7
    Responsable
    Office & Excel

    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
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    Vous avez apprécié la réponse? =>
    ---------------

  8. #8
    Membre à l'essai
    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.

  9. #9
    Expert éminent
    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.

    Bien Cordialement.

    Marcel

    Dernier billet:
    Suppression des doublons d'un tableau structuré, gestion d'un array

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.


  10. #10
    Membre à l'essai
    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 !!!

  11. #11
    Responsable
    Office & Excel

    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...
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    Vous avez apprécié la réponse? =>
    ---------------

  12. #12
    Membre à l'essai
    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 !

  13. #13
    Expert éminent
    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.

    Bien Cordialement.

    Marcel

    Dernier billet:
    Suppression des doublons d'un tableau structuré, gestion d'un array

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.


  14. #14
    Membre à l'essai
    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

  15. #15
    Expert éminent
    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.

    Bien Cordialement.

    Marcel

    Dernier billet:
    Suppression des doublons d'un tableau structuré, gestion d'un array

    Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.


###raw>template_hook.ano_emploi###