Séparateur et renommage d'une plage de cellule

Le 26/03/2021 à 11:38

Bonjour tout le monde,

Nouvelle question du jour

J'avais fait une demande par rapport au fait de séparer dans une colonne les données qui ont un ";" et que tout se retrouve au sein d'une même colonne ce qui donnait ceci :

Set Fsource = Sheets("Généralités")
Set Fdest = Sheets("Données")

Fdest.Range("G1").CurrentRegion.Offset(1, 0).ClearContents
dl = Fsource.Range("B" & Rows.Count).End(xlUp).Row
    For g = 8 To dl
    If Fsource.Range("B" & g) <> "" Then
        x = Split(Sheets("Généralités").Range("B" & g), ";")
            With Sheets("Données")
            derlig = .Range("G" & Rows.Count).End(xlUp).Row + 1
            .Cells(derlig, "G").Resize(UBound(x) + 1) = Application.Transpose(x)
        End With
    Erase x
    End If
Next g

Mais du coup en fait j'aimerais faire autrement c'est à dire que une ligne serait dans une colonne en gros si en B8 j'ai 32;10;5;8 alors j'aurais bien ces valeurs dans une même colonne par contre les valeurs dans B9 serait dans une autre colonne.

Le but après ça serait de renommer chaque plage de cellule nouvelle par le nom de la matière leur correspondant.

Exemple :

A8 = STRATIFIE et B8 =32;10;5;8 alors dans mon onglet "Données" en G j'aurais G1 = 32 / G2 = 10 / G3 = 5 / G4 = 8 et ma plage de cellule de G1 à G4 sera appelée STRATIFIE

J'espère que je suis assez compréhensible

Merci d'avance à vous !

Cordialement,

8need.xlsm (53.25 Ko)
Le 26/03/2021 à 12:28

Salut kinders59,

À tester :

Set Fsource = Sheets("Généralités")
Set Fdest = Sheets("Données")

Fdest.Range("G1").CurrentRegion.Offset(1, 0).ClearContents
dl = Fsource.Range("B" & Rows.Count).End(xlUp).Row
    For g = 8 To dl
    If Fsource.Range("B" & g) <> "" Then
        x = Split(Sheets("Généralités").Range("B" & g), ";")
            With Sheets("Données")
            derlig = .Range("G" & Rows.Count).End(xlUp).Row + 1
            .Cells(derlig, "G").Resize(UBound(x) + 1) = Application.Transpose(x)
            ActiveWorkbook.Names.Add Name:=Fsource.Range("A" & g).value, RefersTo:=.Range("G" & derlig - LBound(x) +1 & ":G" & derlig)
        End With
    Erase x
    End If
Next g

Set Fsource = Nothing
Set Fdest = Nothing

Ne pas oublier à la fin de la macro de vider les variables objets (Déclaré avec "Set")

Le 26/03/2021 à 14:02

Hello Baboutz,

J'ai testé mais j'ai une erreur (1004) sur ça :

ActiveWorkbook.Names.Add Name:=Fsource.Range("A" & g).value, RefersTo:=.Range("G" & derlig - LBound(x) +1 & ":G" & derlig)

J'imagine que cette ligne fait référence au fait de changer le nom de la plage de cellule c'est ça ?

Merci à toi,

Cordialement

Le 26/03/2021 à 14:39

Re,

J'avais fait des erreurs en plus, macro corrigée :

Set Fsource = Sheets("Généralités")
Set Fdest = Sheets("Données")

Fdest.Range("G1").CurrentRegion.Offset(1, 0).ClearContents
dl = Fsource.Range("B" & Rows.Count).End(xlUp).Row
    For g = 8 To dl
    If Fsource.Range("B" & g) <> "" Then
        x = Split(Sheets("Généralités").Range("B" & g), ";")
            With Sheets("Données")
            derlig = .Range("G" & Rows.Count).End(xlUp).Row + 1
            .Cells(derlig, "G").Resize(UBound(x) + 1) = Application.Transpose(x)
            If InStr(Fsource.Range("B" & g), ";") <> 0 Then
                ActiveWorkbook.Names.Add Name:=Fsource.Range("A" & g).Value, RefersTo:=.Range("G" & derlig & ":G" & derlig + UBound(x))
            Else
                ActiveWorkbook.Names.Add Name:=Replace(Fsource.Range("A" & g).Value, " ", "_"), RefersTo:=.Range("G" & derlig)
            End If
        End With
    Erase x
    End If
Next g

Set Fsource = Nothing
Set Fdest = Nothing

Par contre l'erreur 1004 vient du fait qu'il y ait un espace à "CHENE ABOUTE" du coup j'ai remplacé l'espace par un "_" ce qui donne que la plage se nomme "CHENE_ABOUTE". Donc à faire attention par la suite si tu manipules la plage

Bonne soirée,

Baboutz

Le 28/03/2021 à 15:33

Hello Baboutz,

Merci beaucoup pour ton aide, penses-tu qu'il soit possible de faire en sorte que mes données ressortent mais dans des colonnes différentes ?

C'est à dire que par exemple les données de B8 se retrouvent dans la colonne G, que les données de B9 soit en colonne H ... et que je puisse reprendre le nom de la matière en en-tête ?

Sinon je me disais de passer par une CONCAT de ma matière avec l'épaisseur mais je ne sais pas comment séparer ensuite mon nom de matière avec les données qui contiennent le ";"

Car aujourd'hui ça me donnerait par exemple HETRE28;15;5 mais comment faire ensuite pour avoir : HETRE 28 sur une ligne / HETRE 15 sur une autre etc ...

Merci d'avance à toi :)

Le 29/03/2021 à 14:03

Bonjour kinders59,

Code qui met dans chaque colonne :

    'On désactive les messages d'alertes d'excel et on désactive le défilement des macros
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set Fsource = Sheets("Généralités")
    Set Fdest = Sheets("Données")

    Fdest.Range("G1").CurrentRegion.ClearContents

        For g = 8 To Fsource.Range("B" & Rows.Count).End(xlUp).Row
            If Fsource.Range("B" & g) <> "" Then
                x = Split(Fsource.Range("B" & g), ";")
                With Sheets("Données")
                    .Cells(1, g - 1).Value = Fsource.Range("A" & g).Value
                    .Cells(2, g - 1).Resize(UBound(x) + 1) = Application.Transpose(x)
                    If InStr(Fsource.Range("B" & g), ";") <> 0 Then
                        ActiveWorkbook.Names.Add Name:=Fsource.Range("A" & g).Value, RefersTo:=.Range(.Cells(2, g - 1), .Cells(2 + UBound(x), g - 1))
                    Else
                        ActiveWorkbook.Names.Add Name:=Replace(Fsource.Range("A" & g).Value, " ", "_"), RefersTo:=.Cells(2, g - 1)
                    End If
                End With
                Erase x
            End If
    Next g

    'On active les messages d'alertes d'excel
    Application.DisplayAlerts = True

    Set Fsource = Nothing
    Set Fdest = Nothing

Bonne journée,

Baboutz

Le 29/03/2021 à 16:51

Hello Baboutz,

Merci pour cette réponse :)

Je vais être encore un peu chiant mais sais-tu si il est possible de faire en sorte qu'au lieu d'avoir une en-tête je puisse avoir sur chaque ligne une reprise de la matière avec une épaisseur ?

Du coup on aurait par exemple dans une même colonne :

Hetre 15 (en G1)

Hetre 20 (en G2)

Hetre 6 (en G3)

...

Je me suis dit de rassembler

 .Cells(1, g - 1).Value = Fsource.Range("A" & g).Value
  .Cells(2, g - 1).Resize(UBound(x) + 1) = Application.Transpose(x)

Mais je dois faire un truc mal car ça fonctionne pas

Le 29/03/2021 à 17:06

Re,

Il faut ajouter :

For i = 0 To UBound(x): x(i) = Fsource.Range("A" & g).Value & " " & x(i): Next i

Essaie de comprendre le code pour pouvoir t'améliorer
J'ai également corriger une erreur que j'avais fais sur le dernier code fourni, j'ai ajouter la variable j pour pouvoir incrémenter ou non le N° de colonne.

Ton code en entier :

    'On désactive les messages d'alertes d'excel et on désactive le défilement des macros
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set Fsource = Sheets("Généralités")
    Set Fdest = Sheets("Données")

    Fdest.Range("G1").CurrentRegion.ClearContents
    j = 7
        For g = 8 To Fsource.Range("B" & Rows.Count).End(xlUp).Row
            If Fsource.Range("B" & g) <> "" Then
                x = Split(Fsource.Range("B" & g), ";")
                For i = 0 To UBound(x): x(i) = Fsource.Range("A" & g).Value & " " & x(i): Next i
                With Sheets("Données")
                    .Cells(1, j).Value = Fsource.Range("A" & g).Value
                    .Cells(2, j).Resize(UBound(x) + 1) = Application.Transpose(x)
                    If InStr(Fsource.Range("B" & g), ";") <> 0 Then
                        ActiveWorkbook.Names.Add Name:=Fsource.Range("A" & g).Value, RefersTo:=.Range(.Cells(2, j), .Cells(2 + UBound(x), 7))
                    Else
                        ActiveWorkbook.Names.Add Name:=Replace(Fsource.Range("A" & g).Value, " ", "_"), RefersTo:=.Cells(2, j)
                    End If
                End With
                Erase x
                j = j + 1
            End If
    Next g

    'On active les messages d'alertes d'excel
    Application.DisplayAlerts = True

    Set Fsource = Nothing
    Set Fdest = Nothing

Bonne fin de journée,

Baboutz

Le 30/03/2021 à 09:30

Hello Baboutz,

Je te remercie beaucoup pour ton aide et toutes tes réponses c'est vraiment top ! Effectivement il faut que je comprennes le code c'est assez compliqué surtout que c'est un peu complexe ici haha

Je suis preneur des petits messages comme tu as fait pour me dire que tu désactives les messages d'alertes

Encore merci à toi, très beau travail !

Le 30/03/2021 à 14:25

Re,

Oui avec plaisir !

    'On désactive les messages d'alertes d'excel et on désactive le défilement des macros
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'Attribution des variables objets
    Set Fsource = Sheets("Généralités")
    Set Fdest = Sheets("Données")

    'Nettoyage de la plage de cellules
    Fdest.Range("G1").CurrentRegion.ClearContents

    'Attribution de la valeur 7 à la variable j
    j = 7

    'Pour g = 8 jusqu'à la dernière cellule non vide de la colonne
    For g = 8 To Fsource.Range("B" & Rows.Count).End(xlUp).Row

        'Si une épaisseur  est renseignée alors
        If Fsource.Range("B" & g) <> "" Then

            'Attribue les différentes valeurs à l'array x
            x = Split(Fsource.Range("B" & g), ";")

            'Pour i = 1 jusqu'au N0° du dernier item de l'array x,  ajoute le nom de l'essence devant l'épaisseur
            For i = 0 To UBound(x): x(i) = Fsource.Range("A" & g).Value & " " & x(i): Next i

            'Avec la feuille Données
            With Sheets("Données")

                'Attribue le nom de l'essence à la première cellule
                .Cells(1, j).Value = Fsource.Range("A" & g).Value

                'Ajoute tous les éléments de l'array x
                .Cells(2, j).Resize(UBound(x) + 1) = Application.Transpose(x)

                'Si il y a plus d'une épaisseur d'essence alors
                If InStr(Fsource.Range("B" & g), ";") <> 0 Then

                    'Attribue un nom à la plage
                    ActiveWorkbook.Names.Add Name:=Fsource.Range("A" & g).Value, RefersTo:=.Range(.Cells(2, j), .Cells(2 + UBound(x), 7))

                'Sinon attribue un nom à la plage
                Else
                    ActiveWorkbook.Names.Add Name:=Replace(Fsource.Range("A" & g).Value, " ", "_"), RefersTo:=.Cells(2, j)
                End If
            End With

            'Supprime l'array
            Erase x

            'Incrémente la variable j
            j = j + 1
        End If
    Next g

    'On active les messages d'alertes d'excel
    Application.DisplayAlerts = True

    'Vide les variables objets - Allège la mémoire
    Set Fsource = Nothing
    Set Fdest = Nothing

Et voilà !

Bonne journée,

Baboutz

Le 31/03/2021 à 08:59

Hello Baboutz,

Tu es mon héro

Merci beaucoup à toi !

Bonne journée et bon courage !

Le 31/03/2021 à 09:16

Salut,

Avec grand plaisir kinders59 !

Passe également une bonne journée et à une prochaine peut-être !

Baboutz

Rechercher des sujets similaires à "separateur renommage plage"