XL 2013 [Résolu] -VBA-Insertion de ligne fonction de la valeur d'une cellule et copie de valeur

[Vincent_2311]

Bonjour à toutes et tous,

Je me permet de vous consulter car je pense avoir un soucis solutionnable via VBA ce qui n'est pas mon fort.

J'ai une fichier m'indiquant pour chaque ville, quels sont les modèles de produit qui vont être modifiés pour la nouvelle année (1 ligne de ville peut comprendre plusieurs modèles)

J'ai besoin de me faire une feuille récap dans laquelle j'aurais une ligne par modèle et par ville et là est ma difficulté.

Je mets en pièce jointe le fichier avec des annotations pour être plus compréhensible.

En espérant que mon post vous donnera envie de relever ce "challenge".

Bonne journée à tous.

Vincent

 

[kingfadhel]

Bonsoir,
1- l'insertion de ligne à quel niveau et sur quelle feuille
2- sur quelle base
3- quels sont les modèles

donne des exemples avec des flèches, des couleurs, des commentaires....

 

[laurent950]

Bonsoir

une solution avec explication débutant :

Sub recap()
' je fais facile pour vous
Sheets("Complet").Activate
' der = derniere ligne du tableau
der = Range("B65536").End(xlUp).Row
' Boucle
' 5 modele = 5 colonnes sur 14 lignes donc
' Vil = stocke les Ville par Numéro
For i = 7 To der ' ligne
    vil = Cells(i, 2) ' colonne des ville
    For j = 4 To 8 ' colonne 4(D) a 8(H)
        ' cptLigne = le nombre de ligne a crée
        ' cptLigne = variable ou sont stoké les resultats
        If Cells(i, j) = 1 Then
            ' vrais
            ' incremente le compteur + 1
            cptLigne = cptLigne + 1
        Else
            ' aucune action
        End If
    Next j
    ' On remplis la Feuille Recap
        'donc on va sur la feuille
            Sheets("Recap").Activate
            ' ont peux commencer la boucle
            ' Condition sivariable vide pour l'initialisé
            If cptrecap = "" Then
                ' ont commence a la ligne N° 2
                ' Donc un autre compteur
                'cptrecap = 2 pour initialisé la variable
                cptrecap = 2
            End If
    For k = 1 To cptLigne
        Cells(cptrecap, 1) = vil
            ' incremente le compteur + 1
                cptrecap = cptrecap + 1
    Next k
    ' ont efface le resultat des variables pour la suite
    vil = Empty
    cptLigne = Empty
    ' Ont retourne sur la feuille Complet
    Sheets("Complet").Activate
Next i
End Sub

 

[Vincent_2311]

Bonjour,

Merci d'avoir pris le temps de regarder mon fichier. Je l'ai complété avec plus d'informations en espérant avoir été plus clair !

Merci.

 

[laurent950]

C'est possible vous avez la maîtrise des variables tableaux ?

 

[Vincent_2311]

Bonsoir Laurent950,

Merci beaucoup d'avoir su répondre à mon soucis ! Grâce à vous la première partie de mon problème est résolue à savoir créer le nombre de ligne en fonction du nombre de modèle à changer !

Maintenant j'aimerais pouvoir du coup alimenter ces lignes créées.

Dans l'onglet Récap, le nombre de ligne a créé dépend du nombre de modèle à changer du fichier de départ. Ces modèles doivent se retrouver ensuite dans chacune des lignes créées, la finalité étant celle-ci afin que dans je puisse lister dans une colonne les différents modèles en fonction de la ville de manière verticale (besoin pour des compléments d'information que je rajouterai plus tard via un rechechev).

Bon je vais essayer de digérer ce beau bout de code que vous avez réussi à faire, et vous remercie énormément pour votre aide précieuse.

Bonne soirée à vous !

Vincent

 

[Vincent_2311]

C'est possible vous avez la maîtrise des variables tableaux ?

Oui je peux modifier le tableau en fonction des besoins. Enfin dans la limite du raisonnable

 

[laurent950]

Pour Comprendre c'est un tableaux existant à compléter ?
- Il faudrait le premier tableaux (Je veux que ca ressemble à ça)
- Puis le tableaux qui correspond (Fichier de départ)
C'est à dire la base puis ensuite
-- Puis le tableaux qui correspond (Fichier de départ) mais complété donc celui qui va générer
le tableau (Je veux que ca ressemble à ça) avec les ligne en rouge...

Voila (Les couleurs rouge c'est nécessaire ? ou ont peux ajouté un index pour notifier les évolutions au fils du temps pour les modifications du tableau de départ et l'agrémenter sans limite !

Faire des synthèses des ajouts (au fils du temps)

c'est des idées ?

 

[Vincent_2311]

Bonsoir,

Merci pour votre suivi.

Le fichier n'est pas voué à être réutiliser à l'infini.

L'idée est de pouvoir transformé mon "fichier de départ" en un fichier exploitable via un recherche v.

C'est à dire que une fois que j'ai réussi à avoir dans mon onglet "je veux que ca ressemble à ca"

Ville 1 Produit A
Ville 1 Produit B
Ville 2 Produit D

Alors je pourrais faire une recherchev (enfin qq'chose que je maitrise ) disant:

Si Produit A alors...
Si produit B alors...

Et compléter ainsi mon tableau

Ville 1 Produit A Réponse X
Ville 1 Produit B Réponse Y
Ville 2 Produit A Réponse X
Ville 2 Produit D Réponse Z

En espérant avoir été clair dans l'objectif de ma demande.

P.S: Les couleurs sont annexes, elles doivent juste permettre au gens qui m'aident de mieux comprendre mon besoin

Vincent

 

[laurent950]

Sub test()
Dim BaseDepart As Worksheet
Set BaseDepart = Worksheets("Fichier de départ")

Dim Result As Worksheet
Set Result = Worksheets("Je veux que ca ressemble à ça")

Dim Tbase() As Variant
Tbase = BaseDepart.Range(BaseDepart.Cells(1, 1), BaseDepart.Cells(BaseDepart.Cells(6536, 2).End(xlUp).Row, 8))

ReDim Preserve Tbase(LBound(Tbase, 1) To UBound(Tbase, 1), LBound(Tbase, 2) To UBound(Tbase, 2) + 6)
' compteur
Dim cpt As Double
cpt = 0
For i = 7 To UBound(Tbase, 1)
    For j = 4 To 8
        If Tbase(i, j) = 1 Then
            Tbase(i, 9) = Tbase(i, 9) + 1
            Tbase(i, Tbase(i, 9) + 9) = Tbase(2, j)
        End If
    Next j
    cpt = cpt + Tbase(i, 9)
Next i
i = Empty

' créer le tableau récap
Dim Trecap() As Variant
ReDim Trecap(1 To cpt, 1 To 2)
cpt = 1
        For j = 7 To UBound(Tbase, 1)
            For K = 10 To 14
                If Tbase(j, K) <> Empty Then
                    Trecap(cpt, 1) = Tbase(j, 2)
                    Trecap(cpt, 2) = Tbase(j, K)
                    cpt = cpt + 1
                End If
            Next K
        Next j
' coller sur la feuille
' on colle le résultat
Result.Cells(2, 1).Resize(UBound(Trecap, 1), UBound(Trecap, 2)) = Trecap
End Sub

 

[Vincent_2311]

Bonjour Laurent950,

Magnifique ca fonctionne à la perfection, un grand bravo à vous et un grand merci pour votre aide !!

Vincent