inserer calcul dans une Macro

[yamzza]

Bonjour à tous

Je souhaite créer une Macro et insérer quelques formules afin de gagner du temps dans le traitement des données d’un fichier.

Je reçois plusieurs fois par jour un fichier « feuille A » avec pour chaque produit des volumes (M3) à préparer à une date donnée.

Afin de me simplifier la tâche, j’ai déjà mis en place une Macro pour me permettre de mettre en forme ma « feuille A » :
- tri par produit
- tri par date de préparation


J’aimerai intégrer à cette Macro quelques calculs :

Dans ma « Feuille B » j’ai des facteurs de conversion qui me permettent de convertir mes volumes (en feuille A) en nombre de palette par produit et par date.

Est-il possible d’intégrer un calcul me permettant de connaitre instantanément le nombre de palette à préparer par date ?

- somme des volumes par produit et par date
- multiplier somme des volumes par produit et par date par facteur de conversion correspondant.

Par avance merci de votre aide.

 

[CHALET53]

Re : inserer calcul dans une Macro

Bonjour,

A affiner

Avec un TCD et la fonction Recherche

J'ai ramené la feuille B sur le fichier A

 

[Robert]

Re : inserer calcul dans une Macro

Bonsoir le fil, bonsoir le forum,

Une proposition VBA avec le code ci-dessous :

Sub Macro2()
Const n As String = "feuille B" 'déclare la constante n (Nom)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim temp As Variant 'déclare la variable temp (tableau TEMPoraire)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim pv As Range 'déclare la variable pv (Plage Visible)
Dim s As Double 'déclare la variable s (Somme)
Dim c As Double 'déclare la variable c (Coéficient)

Application.ScreenUpdating = False 'masque les changements à l'écran
With Sheets("feuille A") 'prend en compte l'onglet "feuille A"
    Set pl = .Range("A1").CurrentRegion 'définit la plage pl
    'redéfinit la plage pl (sans la première ligne)
    Set pl = pl.Offset(1, 0).Resize(pl.Rows.Count - 1, pl.Columns.Count)
    For col = 2 To 3 'boucle sur les colonnes 2 à 3
        Set dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dico
        For Each cel In Application.Intersect(pl, Columns(col)) 'boucle sur toutes les cellules de la plage pl en colonne col
            dico(cel.Value) = "" 'alimente le dictionnaire dico
        Next cel 'prochaine cellule de la boucle
        temp = dico.keys 'récupère le dictionnaire sans doublon
        If col = 2 Then td = temp Else tp = temp 'alimente le table td (tableau des dates) puis le tableau tp (tableau de produits)
        Erase temp 'efface le tableau temp
    Next col 'prochaine colonne de la boucle
    .Range("J1").CurrentRegion.Clear 'efface les anciennes données
    .Range("J1").Value = "Date" 'place "Date" en J1
    .Range("K1").Value = "Produit" 'place "Produit" en K1
    .Range("L1").Value = "Somme" 'place "Somme" en L1
    .Range("M1").Value = "Coéficient" 'place "Somme" en L1
    .Range("N1").Value = "Calcul" 'place "Calcul" en M1
    For i = LBound(td, 1) To UBound(td, 1) 'boucle 1 : sur toutes les valeurs du tableau de dates
        For j = LBound(tp, 1) To UBound(tp, 1) 'boucle 2 : sur toutes les valeurs du tableau de produits
            .Range("A1").AutoFilter 'mode filtre automatique
            .Range("A1").AutoFilter field:=2, Criteria1:=td(i) 'filtre la colonne B par rapport à la date
            .Range("A1").AutoFilter field:=3, Criteria1:=tp(j) 'fitre la colonne C par rapport au produit
            On Error Resume Next 'gestion des erreurs (en cas d'erreur, passe à la ligne suivante)
            Set pv = pl.SpecialCells(xlCellTypeVisible) 'définit la plage pv (génère une erreur si aucune ligne visible après filtre)
            If Err <> 0 Then 'condition : si une erreur a été générée
                Err = 0 'annule l'erreur
                GoTo suite 'va à l'étiquette "Suite"
            End If 'fin de la condition
            On Error GoTo 0
            s = Application.WorksheetFunction.Sum(Application.Intersect(pv, Columns(6))) 'définit la somme s
            c = Workbooks(n & ".xls").Sheets(n).Columns(1).Find(tp(j), , xlValues, xlWhole).Offset(0, 1) 'définit de coéficient c
            .Range("A1").AutoFilter 'annule le filtre automatique
            Set dest = .Cells(Application.Rows.Count, 10).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
            dest.Value = td(i) 'place la date
            dest.Offset(0, 1).Value = tp(j) 'place le produit
            dest.Offset(0, 2).Value = s 'place la somme
            dest.Offset(0, 3).Value = c 'place le coéficient
            dest.Offset(0, 4).Value = s * c 'place le cacul somme * coéficient
suite: 'étiquette
        Next j 'prochain produit de la boucle 2
    Next i 'prochaine date de la boucle 1
    If .FilterMode = True Then .Range("A1").AutoFilter 'si l'onglet est en mode fitre automatique, supprime le filtre
End With 'fin de la prise en compte de l'onglet "feuille A"
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub

Le fichier :