Création code VBA complexe

Bonjour à tous,

Je suis nouvelle sur le forum et je viens à vous, je dois créer un code vba afin de simplifier l'utilisation d'un fichier mais j'ai beaucoup de mal car je ne le fait pas souvent.

Je souhaite créer le code suivant :

À partir de la colonne clé de l'onglet DONNÉES, je souhaiterais remplir les colonnes "activité et service" de l'onglet BALANCE

Si je retrouve la même clé dans l'onglet BALANCE, je veux affecter l'activité et le service associé qui se trouve dans l'onglet DONNEES colonne E et F

Lorsque le % répartition est à 100 %, on affecte l'activité et le service directement à la clé associée

Mais (CE QUI EST PLUS COMPLEXE)

Pour les clés avec des pourcentages d'affection n'étant pas à 100 %, il faudrait ajouter dans l'onglet BALANCE autant de lignes que j'ai de clé dans l'onglet DONNES

et mettre les activités et service associé et prendre le montant de la ligne de l'onglet BALANCE et le répartir avec le pourcentage de répartition.

ci-joint un exemple de mon fichier.

je vous remercie par avance pour votre aide.

Bonjour à tous !

Et....

Pas certain d'avoir correctement appréhendé votre problématique, des répartitions cumulées peuvent être supérieures au montant initial (2 cas), je vous propose néanmoins cette approche via Power Query (nativement intégré à votre Excel) :

Bonsoir JFL,

Je vous remercie pour ton retour.

C'est ce que je cherchais a faire et vous avez bien compris ma requête. Je n'ai jamais utilisé Power Query mais je vais m'inspirer de ce que vous m'avez donné pour bien comprendre le mécanisme et le refaire moi-même.

Merci beaucoup pour votre aide :).

Pouvez-vous m'expliquer comment vous avez construit le tableau final s'il vous plait dans Power Query ?

Dans les étapes appliqués j'ai pas compris comment vous avez fait le passage entre la source et le tableau donnée développé.

Je vous remercie par avance de votre aide.

Bonsoir à tous !

Les deux premières requêtes (t_Donn et t_Bal) correspondent aux deux tableaux structurés de votre classeur.

La troisième requête (t_Final) est une jointure des deux premières sur la base de l'identifiant "CLE". Par "jointure", comprendre établir un lien sur la base d'un élément commun unique.
La base remontée via la jointure est ensuite développée selon les besoins.
La suite de la requête est une simple multiplication (montant * %). On termine le traitement par un typage du champ "Montant réparti"

Je te remercie pour ton retour, j'ai compris la manipulation. J'ai un autre problème que je n'ai pas mentionné dans mes précédents post, dans mon fichier j'ai d'autre colonne à la suite avec des formules et ça ne fonctionne pas avec power query, en effet, lorsqu'il charge le fichier j'ai des erreurs (je pense dû aux colonnes ayant des formules) du coup, je pense pas que je puisse utiliser power query pour mon cas.

Bonjour à tous !

Ket a écrit :

........J'ai un autre problème que je n'ai pas mentionné dans mes précédents post, dans mon fichier j'ai d'autre colonne à la suite avec des formules et ça ne fonctionne pas avec power query,......

D'où l'impérieuse nécessité, répétée moult fois, de présenter un classeur représentatif de votre environnement. Cela permet une réponse appropriée et évite de perdre du temps.

Bon courage pour la suite.

Je sais bien... je vais faire le nécessaire et je reviens vers vous pour vous dire si j'ai trouvé une solution.

Merci encore et bon week-end à vous.

Bonsoir, j'ai réussi a créer une macro mais je me retrouve coincé car ma macro fonctionne mais est trop lente, j'ai beaucoup de ligne dans a feuille (+10 000 lignes) et les boucles que j'ai faites pour supprimer des lignes dans ma feuille ralentisse ma macro et ma macro est beaucoup trop lente 30 min pour supprimer 1000 lignes de ma 1ere boucles , j'aimerais savoir comment je peux optimiser ma macro pour que la suppression de ces lignes se fasse beaucoup plus rapidement.

Je vous remercie pour votre aide.

Ci-dessous ma macro :

Sub nettoyage ()

Dim i as long

Dim J as long

Dim K as long

Dim Derniere_Ligne as Long

Sheets("ECBU - Valoptia").Activate

Derniere_Ligne = Range("a1").End(xlDown).Row

For i = 2 To Derniere_Ligne

If Cells(i, "a") = "CA" Or Cells(i, "a") = "RE" Or Cells(i, "a") = "BT" Or Cells(i, "a") = "RA" Then

Cells(i, "a").EntireRow.Delete

End If

Next i


For j = 2 To Derniere_Ligne

If Cells(j, "i") = "51" or Cells(j, "i") = "55" Then

Cells(j, "i").EntireRow.Delete

End If

Next j

For k = 2 To Derniere_Ligne

If Cells(k, "l") = "905" Or Cells(k, "l") = "921" Or Cells(k, "l") = "9311"Or Cells(k, "l") = "9316"Or Cells(k, "l") = "93145" Or Cells(k, "l") = "9316"Or Cells(k, "l") = "9389"Or Cells(k, "l") = "9309"Or Cells(k, "l") = "93123"Or Cells(k, "l") = "93156"Or Cells(k, "l") = "9367"Or Cells(k, "l") = "93187"Or Cells(k, "l") = "9382"Or Cells(k, "l") = "93102"Or Cells(k, "l") = "9376"Or Cells(k, "l") = "9389"Or Cells(k, "l") = "93167"Or Cells(k, "l") = "9398" Then

Cells(k, "l").EntireRow.Delete

End If

Next k

Columns("Q:BL").Select
Selection.Delete shift:=xlToLeft

end sub

bonsoir,

une proposition vba qui devrait prendre moins de temps... des optimisations sont encore possibles.

Sub nettoyage()
    Dim i As Long
    Dim Derniere_Ligne As Long, colonneasupprimer As Long

    With Sheets("ECBU - Valoptia")
        Derniere_Ligne = .Range("a1").End(xlDown).Row
        colonneasupprimer = .UsedRange.Columns.Count + 1
        ReDim tb(1 To Derniere_Ligne, 0)
        For i = 2 To Derniere_Ligne
            If .Cells(i, "a") = "CA" Or .Cells(i, "a") = "RE" Or .Cells(i, "a") = "BT" Or .Cells(i, "a") = "RA" Then
                tb(i, 0) = "x"
            ElseIf .Cells(i, "i") = "51" Or .Cells(i, "i") = "55" Then
                tb(i, 0) = "x"
            ElseIf .Cells(i, "l") = "905" Or .Cells(i, "l") = "921" Or .Cells(i, "l") = "9311" Or .Cells(i, "l") = "9316" Or .Cells(i, "l") = "93145" Or .Cells(i, "l") = "9316" Or .Cells(i, "l") = "9389" Or .Cells(i, "l") = "9309" Or .Cells(i, "l") = "93123" Or .Cells(i, "l") = "93156" Or .Cells(i, "l") = "9367" Or .Cells(i, "l") = "93187" Or .Cells(i, "l") = "9382" Or .Cells(i, "l") = "93102" Or .Cells(i, "l") = "9376" Or .Cells(i, "l") = "9389" Or .Cells(i, "l") = "93167" Or .Cells(i, "l") = "9398" Then
                tb(i, 0) = "x"
            End If
        Next i
        .Cells(1, colonneasupprimer).Resize(Derniere_Ligne, 1) = tb
        .Range("A1").Resize(Derniere_Ligne, colonneasupprimer).Sort key1:=.Cells(1, colonneasupprimer), order1:=xlAscending, Header:=xlYes
        .Cells(1, colonneasupprimer).Resize(Derniere_Ligne, 1).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
        .Columns("Q:BL").Delete shift:=xlToLeft
    End With

End Sub

Bonjour H2so4,

Merci beaucoup pour ton aide. Je vais essayer ce code :)

Bonne journée !

Bonjour,

J’ai gardé le code que m’avais suggéré H2so4 en enlevant la suppression de colonne Q à BL (dernière ligne du code). Mon tableau commence de la colonne A jusqu’à AW et je souhaiterais que ces retraitements ne se fasse uniquement de la colonne A à R et pas jusqu’à AW. En effet, à partir de la colonne S jusqu’à AW j’ai des cellules avec des formules.
je souhaiterais garder le meme code (car il fonctionne bien) sauf que je ne veux pas qu’il s’applique au-delà de la colonne R.

je vous remercie par avance de votre aide.

Le code en question :

Sub nettoyage()

Dim i As Long

Dim Derniere_Ligne As Long, colonneasupprimer As Long

With Sheets("ECBU - Valoptia")

Derniere_Ligne = .Range("a1").End(xlDown).Row

colonneasupprimer = .UsedRange.Columns.Count + 1

ReDim tb(1 To Derniere_Ligne, 0)

For i = 2 To Derniere_Ligne

If .Cells(i, "a") = "CA" Or .Cells(i, "a") = "RE" Or .Cells(i, "a") = "BT" Or .Cells(i, "a") = "RA" Then

tb(i, 0) = "x"

ElseIf .Cells(i, "i") = "51" Or .Cells(i, "i") = "55" Then

tb(i, 0) = "x"

ElseIf .Cells(i, "l") = "905" Or .Cells(i, "l") = "921" Or .Cells(i, "l") = "9311" Or .Cells(i, "l") = "9316" Or .Cells(i, "l") = "93145" Or .Cells(i, "l") = "9316" Or .Cells(i, "l") = "9389" Or .Cells(i, "l") = "9309" Or .Cells(i, "l") = "93123" Or .Cells(i, "l") = "93156" Or .Cells(i, "l") = "9367" Or .Cells(i, "l") = "93187" Or .Cells(i, "l") = "9382" Or .Cells(i, "l") = "93102" Or .Cells(i, "l") = "9376" Or .Cells(i, "l") = "9389" Or .Cells(i, "l") = "93167" Or .Cells(i, "l") = "9398" Then

tb(i, 0) = "x"

End If

Next i

.Cells(1, colonneasupprimer).Resize(Derniere_Ligne, 1) = tb

.Range("A1").Resize(Derniere_Ligne, colonneasupprimer).Sort key1:=.Cells(1, colonneasupprimer), order1:=xlAscending, Header:=xlYes

.Cells(1, colonneasupprimer).Resize(Derniere_Ligne, 1).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete

End With

End Sub