Insertion automatique de lignes à intervalles (VBA)

Version imprimable

24/05/2013, 19h57
vince_uninc

1 pièce(s) jointe(s)

Insertion automatique de lignes à intervalles (VBA)

Bonjour à tous,

C'est ma première utilisation du forum et je commence avec un problème qui est légèrement corsé selon mon niveau d'habiletés.

Dans le fichier en pièce jointe, dans l'onglet 1 on voit une liste avec des numéros de lignes, des numéros de départements et des prix. La combinaison de ces 3 informations fait qu'il n'y a pas de doublons.

Dans l'onglet 2, on voit une liste avec des numéros de lignes, des prix et une colonne indiquant le nombre de prix différents pour un même numéro de ligne.

Ce que je voudrais faire probablement à l'aide d'une macro codée en VBA, c'est d'obtenir une liste entière qui va contenir chaque combinaison unique des 3 infos de l'onglet 1 (des numéros de lignes, des numéros de départements et des prix) et pour chacune de ces combinaisons uniques ajouter les prix des numéros de lignes correspondants dans l’onglet 2.

Pour simplifier votre compréhension j’ai mis un extrait d’exemple à l’onglet 1. On peut constater que pour tous ces combinaisons uniques des 3 infos de l'onglet 1 (des numéros de lignes, des numéros de départements et des prix) il y a uniquement un seul prix 2 donc se prix 2 est ajouté dans la colonne prix 2.

Lignes Dept Prix Prix 2
3024862CL03 1 1 906,18 $ 435,00 $
3024862CL03 17 2 367,35 $ 435,00 $
3024862CL11-8 1 1 906,18 $ 435,00 $
3024862CL12-7 1 1 770,95 $ 4 222,00 $
3024862CL12-7 41 2 619,18 $ 4 222,00 $

Toutefois, comme on peut le constater dans le tableau suivant j’ai seulement 2 combinaisons uniques des 3 infos de l'onglet 1 (des numéros de lignes, des numéros de départements et des prix), mais j’ai 4 Prix 2 différents. Je voudrais donc que pour chacune des 2 combinaisons uniques initiales, il y ait introduction de ligne afin d’indiquer pour chaque combinaison unique les 4 Prix 2 différents.

Lignes Dept Prix Prix
3029051CL0621 1 3 944,63 $ 26 021,00 $
3029051CL0621 1 3 944,63 $ 100,00 $
3029051CL0621 1 3 944,63 $ 912,00 $
3029051CL0621 1 3 944,63 $ 6 755,00 $
3029051CL0621 41 4 840,74 $ 26 021,00 $
3029051CL0621 41 4 840,74 $ 100,00 $
3029051CL0621 41 4 840,74 $ 912,00 $
3029051CL0621 41 4 840,74 $ 6 755,00 $

Ici j’ai seulement utilisé un extrait des données pour l’exemple mais je voudrais ultimement que cette logique soit appliquée à l’ensemble des données. Si vous avez des indices ou savez comment faire je suis ouverts à vos propositions.

Merci d’avance d’avoir pris le temps de tenter de m’aider c’est grandement apprécié!

Bonjour,

cela ne serait-il pas mieux d'indiquer les prix sur une seule ligne, non ?
Lignes           Dept       Prix              Prix 
3029051CL0621      1      3 944,63 $      26 021,00 $      100,00 $      912,00 $      6 755,00 $
3029051CL0621     41      4 840,74 $      26 021,00 $      100,00 $      912,00 $      6 755,00 $
Sinon où la liste à jour doit-elle se trouver ? Dans l'onglet 1 ? Dans un nouvel onglet ? Dans un nouveau classeur ?

Bonjour,

Citation:

cela ne serait-il pas mieux d'indiquer les prix sur une seule ligne, non ?

Ca paraîtrait certainement plus clair en effet. (une seule ligne par entrée).
Mais au final ça dépend comment on se sert des données résultats. (filtre automatique, tri ....)

Citation:

Sinon où la liste à jour doit-elle se trouver ? Dans l'onglet 1 ? Dans un nouvel onglet ? Dans un nouveau classeur ?

Dans le fichier exemple, le résultat semble être en feuille <1> plage "G3:J??"
Le code ci-dessous le travail de fusion, et place le résultat à cet endroit.

Code:

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
Option Explicit
Sub FusionneFeuille1et2()
    Dim srcCode As Variant 'tableau contenant valeurs de la feuille1
    Dim srcMontant As Variant 'tableau contenant valeurs de la feuille2
    Dim destRow As Long  'ligne a partir de laquelle on copie les valeurs fusionnée
    destRow = 3
    Const destCol As Integer = 7 'colonne a partir de laquelle on copie les valeurs fusionnée
 
    With Worksheets("1")
        Set srcCode = .Range("A2:C" & .Range("A2").End(xlDown).Row)
    End With
    With Worksheets("2")
        Set srcMontant = .Range("A2:C" & .Range("A2").End(xlDown).Row)
    End With
 
    Dim codeRow As Long
    Dim MontantRow As Long
 
    Dim lastcodeRow As Long
    Dim lastMontantRow As Long
    lastcodeRow = (Worksheets("1").Range("A2").End(xlDown).Row - 1)
    lastMontantRow = Worksheets("2").Range("A2").End(xlDown).Row - 1
    Application.ScreenUpdating = False
 
    For codeRow = 1 To lastcodeRow
        'Cherche la ligne correspondant à la feuille 1 dans la fueuille2
        Dim nbMontant As Long
        For MontantRow = 1 To lastMontantRow
            If srcMontant(MontantRow, 1).Value = srcCode(codeRow, 1).Value Then
                nbMontant = srcMontant(MontantRow, 3)
                Exit For
            End If
        Next MontantRow
 
        'Copie les valeurs de feuille 1 vers 2
        Do While nbMontant > 0
            If srcMontant(MontantRow, 1).Value = srcCode(codeRow, 1).Value Then
                nbMontant = nbMontant - 1
                With Worksheets("1")
                    .Cells(destRow, destCol) = srcCode(codeRow, 1).Value
                    .Cells(destRow, destCol + 1) = srcCode(codeRow, 2).Value
                    .Cells(destRow, destCol + 2) = srcCode(codeRow, 3).Value
                    .Cells(destRow, destCol + 3) = srcMontant(MontantRow, 2).Value
                End With
                destRow = destRow + 1
            End If
 
            MontantRow = MontantRow + 1
        Loop
    Next codeRow
 
    Application.ScreenUpdating = True
 
    Set srcCode = Nothing
    Set srcMontant = Nothing
 
End Sub

A+