Microsoft 365 Macro pour substituer une cellule par plusieurs cellules

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
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)) +...

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:

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:

bertchristophe

XLDnaute Nouveau
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
bonjour
merci pour ces éléments de réponse. je vais creuser la piste suggérée. bon dimanche
 

bertchristophe

XLDnaute Nouveau
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+
bonjour
merci pour les informations. je jetterai un oeil à votre solution en fin d'après-midi. encore merci et bon dimanche
 

bertchristophe

XLDnaute Nouveau
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+
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

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

Discussions similaires

Réponses
26
Affichages
568

Statistiques des forums

Discussions
312 818
Messages
2 092 376
Membres
105 381
dernier inscrit
stephan57