Discussion :

[argaz01]

Bonjour,

J'ai un tableau sur une feuille Excel, contenant 13 colonnes et aimerais en extraire quelques unes et ensuite trier dans cette nouvelle feuille les lignes selon le contenu d'une autre colonne: ex:

Produit type produit quantité

Nom1 x Nb1
Nom2 x nb2
Nom3 y nb3
Nom4 x
Nom5 y
Nom6 z nb6

Dans la nouvelle feuille j'aimerais avoir la disposition suivante:

Produit Quantité
x nb total
Nom1
Nom2
Nom4

y nb total
nom3
nom5
z
nom6


Comment faire pour que ça soit automatique.
Merci d'avance.

[zyhack]

Bonjour

pour la feuille "Feuil1" en lecture "Produit" "type produit" "quantité" sont en premiere ligne colonne A, B et C

dans la feuille "Feuil2" ou on va écrire "Produit" "quantité" sont en premiere ligne colonne A et B

essaye ce code

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
Sub tri()
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim Lws1 As Long, Lws2 As Long, LmemNb As Long
  Dim memNb As Integer
  Dim TypeP As String
 
  'Le nom des feuilles est à modifier ici
  Set ws1 = Worksheets("Feuil1") 'Feuille lecture
  Set ws2 = Worksheets("Feuil2") 'Feuile ecriture
  'selection de la feuille en lecture
  ws1.Select
  'on commence par effectuer un tri sur 3 colonne
  ws1.Columns("A:C").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2") _
        , Order2:=xlAscending, Header:=xlYes
  Lws1 = 2: Lws2 = 2: TypeP = "": memNb = 0 'init des variables utilisées
 
  'boucle dans la feuille en lecture attention il ne faut pas de trou
  Do While ws1.Cells(Lws1, 1) <> ""
    'si le type est <>
    If TypeP <> ws1.Cells(Lws1, 2) Then
      TypeP = ws1.Cells(Lws1, 2) 'memorisation du type
      ws2.Cells(Lws2, 1) = ws1.Cells(Lws1, 2) 'ecriture du type
      'gestion du total
      If memNb <> 0 Then ws2.Cells(LmemNb, 2) = memNb 'ecriture du total au numero de ligne mémorisé
      LmemNb = Lws2: memNb = 0
      Lws2 = Lws2 + 1
    End If
 
    memNb = memNb + ws1.Cells(Lws1, 3) 'mémorisation du total
    ws2.Cells(Lws2, 1) = ws1.Cells(Lws1, 1) 'écriture du produit
    ws2.Cells(Lws2, 2) = ws1.Cells(Lws1, 3) 'écriture du nombre
    Lws1 = Lws1 + 1: Lws2 = Lws2 + 1 'incrémentation des lignes
  Loop
 
  Set ws1 = Nothing
  Set ws2 = Nothing
End Sub

j'ai fais le test avec les valeurs que tu avais donné et ça fonctionne donc normalement il ne reste plus qu'a adapter

a+

[mercatog]

Bonjour,
une autre proposition avec les tableaux
les données brut peuvent ne pas être triés et les 3 colonnes de données non adjacentes:

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
Sub Transfert()
 
Dim LastLig As Long, i As Long, j As Long, k As Long
Dim tablo(), S() As Double, T() As Double
Dim Temp As String
 
With Sheets("Feuil1")
    'Remplisssage de tablo avec les 3 colonnes dont on a besoin
    LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
    ReDim tablo(1 To 3, 1 To LastLig - 1)
    For i = 2 To LastLig
        tablo(1, i - 1) = .Range("A" & i).Value     'Nom
        tablo(2, i - 1) = .Range("E" & i).Value     'Type
        tablo(3, i - 1) = .Range("K" & i).Value     'Quantité
    Next i
    '-------------------------------------------------Tri tablo en fonction du type
    For i = 1 To UBound(tablo, 2)
        For j = 1 To UBound(tablo, 2) - 1
            If tablo(2, j) > tablo(2, j + 1) Then
                For k = 1 To UBound(tablo, 1)
                    Temp = tablo(k, j)
                    tablo(k, j) = tablo(k, j + 1)
                    tablo(k, j + 1) = Temp
                Next k
            End If
        Next j
    Next i
End With
'-----------------------------------Initialisation
j = 1: ReDim T(1): ReDim S(1)
S(1) = 1: T(1) = tablo(3, 1)
'-----------------------------------Dénombrement par type
For i = 1 To UBound(tablo, 2) - 1
    If tablo(2, i + 1) = tablo(2, i) Then
        S(j) = S(j) + 1
        T(j) = T(j) + tablo(3, i + 1)
    Else
        j = j + 1
        ReDim Preserve S(j)
        ReDim Preserve T(j)
        S(j) = 1
        T(j) = tablo(3, i + 1)
    End If
Next i
'---------------------------------Transfert vers feuil2 des sommes
With Sheets("Feuil2")
    .Cells.ClearContents
    For j = 1 To UBound(T)
        If j = 1 Then
            LastLig = 2
        Else
            LastLig = .Cells(Rows.Count, 1).End(xlUp).Row + S(j - 1) + 1
        End If
        .Range("A" & LastLig) = "Nbre: " & S(j) & " (" & T(j) & ")"
    Next j
    '-----------------------------Transfert vers feuil2 des noms
    i = 1: j = 3
    Do
        If .Range("A" & j) = "" Then
            .Range("A" & j).Value = tablo(1, i)
            i = i + 1
        End If
            j = j + 1
    Loop Until i = UBound(tablo, 2) + 1
End With
End Sub

[argaz01]

Merci les gars pour votre aide, je vais essayer d'adapter tout cela à mon tableau et je vous tiendrai au courant si ça marche. Encore merci.