Microsoft 365 Macro pour substituer une cellule par plusieurs cellules

B

bertchristophe

XLDnaute Nouveau
bonjour, je cherche à faire un macro simple qui permette de remplacer une cellule par plusieurs autres cellules.
Contexte : je vends des produits au détail, et ces mêmes articles peuvent vendus en kit. Ma gestion commerciale me donne le nombre d'articles vendus au détail et le nombre de kits. j'aimerais savoir combien j'ai vendu de produits au total (vente au détail + vente dans des kits). j'ai donc d'un côté les ventes d'articles au détail, de l'autre les ventes de kit. j'ai un onglet avec le détail des kits. j'aimerais remplacer chaque ligne de kit dans mes ventes par toutes les lignes qui composent ce kit, ceci afin d'avoir un total des ventes via un TCD. Je pense qu'il faut passer par une macro, mais je ne maitrise pas la macro de "substitue". d'avance merci pour votre aide. PS : voir fichier joint.
 

Pièces jointes

  • aide excel macro.xlsx
    9.9 KB · Affichages: 5
Solution
job75
Bonjour,

Comme il y a kit et kit 2 il faut tester kit avec Like et le caractère générique *.

Et ajouter un test sur le code du kit pour traiter le kit adéquat.

Aussi modifier les colonnes des fonctions RECHERCHEV :
VB: 
Sub Total_ventes()
Dim ventes, kit, d As Object, i&, code, q&, j&, n&
ventes = [H1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
kit = [A1].CurrentRegion.Resize(, 5)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(ventes)
    If LCase(ventes(i, 2)) Like "kit*" Then
        code = ventes(i, 1)
        q = ventes(i, 3)
        For j = 2 To UBound(kit)
            If kit(j, 1) = code Then d(kit(j, 2)) = d(kit(j, 2)) + q * kit(j, 5)
        Next j
    Else
        d(ventes(i, 1)) = d(ventes(i, 1)) +...
Trier par date Trier par votes
chris

chris

XLDnaute Barbatruc
Bonjour

Je ne sais d'où viennent tes données mais il semble y avoir un problème d'importation avec des caractères non reconnus

Il y a par ailleurs un problème de logique : tu as un unique code kit mais tes ventes supposées contentir des kits et des produits vendus seuls ont le même code produit qui est celui du kit...

Tout cela est faisable aisément via des requête PowerQuery si la logique est bonne... Pas besoin de VBA
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir bertchristophe, chris,

Voici la macro affectée au bouton :
VB: 
Sub Total_ventes()
Dim ventes, kit, d As Object, i&, q&, j&, n&
ventes = [A4].CurrentRegion.Resize(, 3) 'matrice, plus rapide
kit = [A18].CurrentRegion.Resize(, 5)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(ventes)
    If LCase(ventes(i, 2)) = "kit" Then
        q = ventes(i, 3)
        For j = 2 To UBound(kit)
            d(kit(j, 2)) = d(kit(j, 2)) + q * kit(j, 5)
        Next j
    Else
        d(ventes(i, 1)) = d(ventes(i, 1)) + ventes(i, 3)
    End If
Next i
'---restitution---
n = d.Count
With [F4] '1ère cellule de destination, à adapter
    If n Then
        .Resize(n) = Application.Transpose(d.keys)
        .Offset(, 1).Resize(n) = "=IFERROR(VLOOKUP(RC[-1],C1:C2,2,0),VLOOKUP(RC[-1],C2:C3,2,0))"
        .Offset(, 2).Resize(n) = Application.Transpose(d.items)
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
End Sub
A+
 

Pièces jointes

  • aide excel macro(1).xlsm
    19.5 KB · Affichages: 4
Dernière édition:
Vote positif 0 Vote négatif
B

bertchristophe

XLDnaute Nouveau
chris à dit:
Bonjour

Je ne sais d'où viennent tes données mais il semble y avoir un problème d'importation avec des caractères non reconnus

Il y a par ailleurs un problème de logique : tu as un unique code kit mais tes ventes supposées contentir des kits et des produits vendus seuls ont le même code produit qui est celui du kit...

Tout cela est faisable aisément via des requête PowerQuery si la logique est bonne... Pas besoin de VBA
Cliquez pour agrandir...
bonjour
merci pour ces éléments de réponse. je vais creuser la piste suggérée. bon dimanche
 
Vote positif 0 Vote négatif
B

bertchristophe

XLDnaute Nouveau
job75 à dit:
Bonsoir bertchristophe, chris,

Voici la macro affectée au bouton :
VB: 
Sub Total_ventes()
Dim ventes, kit, d As Object, i&, q&, j&, n&
ventes = [A4].CurrentRegion.Resize(, 3) 'matrice, plus rapide
kit = [A18].CurrentRegion.Resize(, 5)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(ventes)
    If LCase(ventes(i, 2)) = "kit" Then
        q = ventes(i, 3)
        For j = 2 To UBound(kit)
            d(kit(j, 2)) = d(kit(j, 2)) + q * kit(j, 5)
        Next j
    Else
        d(ventes(i, 1)) = d(ventes(i, 1)) + ventes(i, 3)
    End If
Next i
'---restitution---
n = d.Count
With [F4] '1ère cellule de destination, à adapter
    If n Then
        .Resize(n) = Application.Transpose(d.keys)
        .Offset(, 1).Resize(n) = "=IFERROR(VLOOKUP(RC[-1],C1:C2,2,0),VLOOKUP(RC[-1],C2:C3,2,0))"
        .Offset(, 2).Resize(n) = Application.Transpose(d.items)
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
End Sub
A+
Cliquez pour agrandir...
bonjour
merci pour les informations. je jetterai un oeil à votre solution en fin d'après-midi. encore merci et bon dimanche
 
Vote positif 0 Vote négatif
B

bertchristophe

XLDnaute Nouveau
job75 à dit:
Bonsoir bertchristophe, chris,

Voici la macro affectée au bouton :
VB: 
Sub Total_ventes()
Dim ventes, kit, d As Object, i&, q&, j&, n&
ventes = [A4].CurrentRegion.Resize(, 3) 'matrice, plus rapide
kit = [A18].CurrentRegion.Resize(, 5)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(ventes)
    If LCase(ventes(i, 2)) = "kit" Then
        q = ventes(i, 3)
        For j = 2 To UBound(kit)
            d(kit(j, 2)) = d(kit(j, 2)) + q * kit(j, 5)
        Next j
    Else
        d(ventes(i, 1)) = d(ventes(i, 1)) + ventes(i, 3)
    End If
Next i
'---restitution---
n = d.Count
With [F4] '1ère cellule de destination, à adapter
    If n Then
        .Resize(n) = Application.Transpose(d.keys)
        .Offset(, 1).Resize(n) = "=IFERROR(VLOOKUP(RC[-1],C1:C2,2,0),VLOOKUP(RC[-1],C2:C3,2,0))"
        .Offset(, 2).Resize(n) = Application.Transpose(d.items)
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
End Sub
A+
Cliquez pour agrandir...
rebonjour
j'essaie de faire des choses simples via le VBA, et d'adapter le fichier que tu m'as gentiment transmis mais j'avoue rencontrer encore un problème. en fait j'essaie d'adapter à plus de kits, mais j'ai du mal à adapter la logique "resize". j'ai intégré un deuxième kit en colonne A (mais en fait je pourrais en avoir plusieurs dizaines si j'extrais tout de ma base de données). j'ai rajouté une vente (H95). mais la zone de calcule automatique ne va pas me chercher le détail du kit 2 dans le renvoi des ventes. sans vouloir abuser, si tu as une explication, ce serait cool. j'ai essayé de chercher sur le web, mais je sèche.
 

Pièces jointes

  • aide excel macro(1) (1)2.xlsm
    20.8 KB · Affichages: 3
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour,

Comme il y a kit et kit 2 il faut tester kit avec Like et le caractère générique *.

Et ajouter un test sur le code du kit pour traiter le kit adéquat.

Aussi modifier les colonnes des fonctions RECHERCHEV :
VB: 
Sub Total_ventes()
Dim ventes, kit, d As Object, i&, code, q&, j&, n&
ventes = [H1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
kit = [A1].CurrentRegion.Resize(, 5)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(ventes)
    If LCase(ventes(i, 2)) Like "kit*" Then
        code = ventes(i, 1)
        q = ventes(i, 3)
        For j = 2 To UBound(kit)
            If kit(j, 1) = code Then d(kit(j, 2)) = d(kit(j, 2)) + q * kit(j, 5)
        Next j
    Else
        d(ventes(i, 1)) = d(ventes(i, 1)) + ventes(i, 3)
    End If
Next i
'---restitution---
n = d.Count
With [L4] '1ère cellule de destination, à adapter
    If n Then
        .Resize(n) = Application.Transpose(d.keys)
        .Offset(, 1).Resize(n) = "=IFERROR(VLOOKUP(RC[-1],C2:C3,2,0),VLOOKUP(RC[-1],C8:C9,2,0))"
        .Offset(, 2).Resize(n) = Application.Transpose(d.items)
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
End Sub
A+
 

Pièces jointes

  • aide excel macro(2).xlsm
    21.3 KB · Affichages: 5
Vote positif 0 Vote négatif
Solution

Discussions similaires

L
  • Résolu(e)
Microsoft 365 Création d'un fichier avec plusieurs feuilles ou des liaisons?
2
Réponses
29
Affichages
2 K
laurabachau
L
D
  • Question
XL 2019 Moyenne pondérée par catégorie
Réponses
7
Affichages
565
djwaas
D
A
  • Question
Microsoft 365 Besoin d'aide pour fabriquer un tableau de bord
Réponses
2
Affichages
542
nat54
nat54
C
  • Résolu(e)
Microsoft 365 Combiner deux tableaux croisés dynamiques - ajouter produit dans TCD
Réponses
2
Affichages
507
cgpa
C
N
  • Résolu(e)
XL 2016 tableau de vente/gestion des stocks boutique : quelles formules ?!
2
Réponses
17
Affichages
2 K
Noëllie
N
C
  • Résolu(e)
XL 2021 Macro dans Macro
2
Réponses
26
Affichages
929
Constantin
C
A
  • Résolu(e)
XL 2016 Passer d'une MFC à une macro pour supprimer le bazar dans les règles.
2 3
Réponses
42
Affichages
1 K
TooFatBoy
TooFatBoy
M
  • Résolu(e)
XL 2013 Macross supprimant les données de cellule en dehors d'une période définie dans deux autres cellules
Réponses
9
Affichages
541
MarineU
M
L
  • Résolu(e)
Microsoft 365 Aide : Colorer une cellule en fonction de sa valeur
Réponses
2
Affichages
325
Leo98
L
V
  • Résolu(e)
XL 2016 Remplir une feuille à partir des données d'une autre
Réponses
7
Affichages
1 K
vanin
V

Membres actuellement en ligne

11 membres et 124 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 133
Messages
2 116 607
Membres
112 804
dernier inscrit
padu