Mise en forme par macro (colonne à ligne)

vgendron

XLDnaute Barbatruc

• 4 Mai 2018

• #2

Hello
avec ce code

VB:

Sub MiseEnForme()
Dim TabInit() As Variant
Dim TabFinal() As Variant

With Sheets("Test")
    TabInit = .UsedRange.Value
    NbLigneFinal = WorksheetFunction.CountA(.Range("A:A"))
End With
For i = LBound(TabInit, 1) To UBound(TabInit, 1)
    If TabInit(i, 1) <> "" Then
        nb = 1
    Else
        nb = nb + 1
        NbMax = WorksheetFunction.Max(NbMax, nb)
    End If
Next i

ReDim TabFinal(1 To NbLigneFinal, 1 To NbMax + 3)
indL = 0
indC = 1
For i = LBound(TabInit, 1) + 1 To UBound(TabInit, 1)
    If TabInit(i, 1) <> "" Then
        indL = indL + 1
        indC = 1
        For j = LBound(TabInit, 2) To UBound(TabInit, 2)
            TabFinal(indL, indC) = TabInit(i, j)
            indC = indC + 1
        Next j
    Else
        TabFinal(indL, indC) = TabInit(i, 4)
        indC = indC + 1
       
    End If
Next i
With Sheets("Resultat")
    .Range("A2").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal
    .Range("A2").Resize(UBound(TabFinal, 1)).NumberFormat = "0"
End With

End Sub

 

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 4 Mai 2018

• #3

Bonjour Acturis
Salut vgendron

Un autre essai

 

Pièces jointes

• Exemple (33).xlsm

  30.2 KB · Affichages: 27

Vote positif 0 Vote négatif

A

Acturis

XLDnaute Nouveau

• 4 Mai 2018

• #4

Bonjour,

Merci pour votre aide !

vgendron, un message apparaît lors de l’exécution de la macro "L'indice n'appartient pas à la sélection" à ce niveau là :
TabFinal(indL, indC) = TabInit(i, j)

Pierrejean, ça fonctionne nickel ! Merci beaucoup

 

Vote positif 0 Vote négatif

A

Acturis

XLDnaute Nouveau

• 4 Mai 2018

• #5

pierrejean à dit:

Bonjour Acturis
Salut vgendron

Un autre essai

Cliquez pour agrandir...

Je me permet de solliciter une nouvelle fois votre aide pour le même travail, mais avec un filtre en plus qui me pose problème.
Dans le fichier exemple 2 j'ai une colonne en plus avec des noms de source...Or je n'aimerai conserver que les classifications "GHS_EU" our les mettre les une à la suite des autres sur la même ligne.
Pensez-vous qu'un tel filtre est possible ?

Merci encore pour votre aide

 

Pièces jointes

• Exemple2.xlsx

  26.7 KB · Affichages: 15
• Resultat manuel 2.xlsx

  10.8 KB · Affichages: 21

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 5 Mai 2018

• #6

Re

Voici

 

Pièces jointes

• Exemple2 (1).xlsm

  40.5 KB · Affichages: 17

Vote positif 0 Vote négatif

A

Acturis

XLDnaute Nouveau

• 5 Mai 2018

• #7

pierrejean à dit:

Re

Voici

Cliquez pour agrandir...

Merci PierreJean, cependant avec cette macro, on ne conserve pas que les classifications "GHS_EU". En effet pour chaque entrée (numéro de spec) il ne faudrait garder que les classifications porvenant du GHS_EU et non pas GHS_RU ou GHS_TR. :/

 

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 5 Mai 2018

• #8

Re

Est-ce mieux ?

 

Pièces jointes

• Exemple2 (1).xlsm

  44.7 KB · Affichages: 18

Vote positif 0 Vote négatif

A

Acturis

XLDnaute Nouveau

• 5 Mai 2018

• #9

pierrejean à dit:

Re

Est-ce mieux ?

Cliquez pour agrandir...

Merci Pierrejean c'est mieux en effet.
Cependant je ne sais pas pourquoi mais la plupart des classifications apparaissent deux fois sur la ligne.
Exemple avec la deuxième entrée :
318-317-360F-335-411-317-360F-335-411

Sans cela ce serait parfait. =)

 

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 6 Mai 2018

• #10

Re
Un problème d'effacement initial mal maîtrisé !!!
Avec correction

 

Pièces jointes

• Exemple2 (1).xlsm

  44.8 KB · Affichages: 21

Vote positif 0 Vote négatif

A

Acturis

XLDnaute Nouveau

• 6 Mai 2018

• #11

pierrejean à dit:

Re
Un problème d'effacement initial mal maîtrisé !!!
Avec correction

Cliquez pour agrandir...

Merci c'est vraiment top !!

 

Vote positif 0 Vote négatif