Réalisation de macro

Bonjour,

j'ai besoin de réaliser une macro pour mon travail. Comme je ne suis pas spécialiste, je me tourne vers vous.

Quelques explications:

J'ai 3 colonnes, article, lot et date.

Je ne veux sélectionner que les lignes qui sont à partir d'une date et les suivantes(2/11/2011 dans mon exemples) date que je mets en I6 avec un bouton pour lancer la macro.

Après avoir trouvé les lignes, il faut faire un total des articles identiques, multiplier par 230 les articles coorespondant aux lots dont le 4eme chiffre en partant de la droite est un 1 ou 2 et par 610 les articles corespondants aux lots dont le 4 eme chiffre est un 3.

Je veux que la macro me donne une somme par article. Fichier joint.

Merci de votre aide.

René

20classeur1.zip (11.19 Ko)

Bonsoir,

As-tu la possibilité d'avoir la colonne "Date" dans un format Date ?

actuellement, c'est du texte et il faudra convertir

Amicalement

Claude

Bonjour,

le m^me fichier avec le format modifié.

René

16classeur1.zip (11.22 Ko)

Bonjour,

Je sais que je ne réponds pas à ta demande de macro mais le match approchant, je n'ai plus le temps !

Une solution sans macro avec deux colonnes auxiliaires qu'on peut masquer.

16r-gouet-v1.zip (14.82 Ko)

Merci MaPoire, exactement ce que je recherche, pas de macro mais cela me suffit.

Encore merci pour ton aide, comme je ne regarde pas le match, je vais faire des éssais.

René

Bonjour à tous,

en VBA

reste à régler la disposition à ta guise

Sub FitreDate()
Dim Lg&, Lg2&
    Application.ScreenUpdating = False
    Lg = Range("c" & Rows.Count).End(xlUp).Row
    '--- efface ---
    Range("k4:t" & Lg).ClearContents
    '--- filtre dates ---
    Range("i2") = "=e4>=$i$3"                       'critère
    Range("c3:e" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("i1:i2"), CopyToRange:=Range("q3:s3"), Unique:=False
    Range("i2").ClearContents
    Lg = Range("q" & Rows.Count).End(xlUp).Row
    Range("t4:t" & Lg) = "=MID(r4,7,1)*1"           'identifiant
    '--- résultats ---
    Range("q2") = "Extraction date"
    Range("q3:q" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("i1:i2"), CopyToRange:=Range("k3"), Unique:=True
    '--- formules ---
    Lg2 = Range("k" & Rows.Count).End(xlUp).Row
    Range("L4:L" & Lg2) = "=SUMPRODUCT(($q$4:$q$" & Lg & "=$k4)*($t$4:$t$" & Lg & "=L$3))"
    Range("m4:m" & Lg2) = "=SUMPRODUCT(($q$4:$q$" & Lg & "=$k4)*($t$4:$t$" & Lg & "=m$3))"
    Range("n4:n" & Lg2) = "=SUMPRODUCT(($q$4:$q$" & Lg & "=$k4)*($t$4:$t$" & Lg & "=n$3))"
    Range("o4:o" & Lg2) = "=SUM(L4:m4)*$L$2+n4*$n$2"
    '--- en dur ---
    Range("L4:o" & Lg2) = Range("L4:o" & Lg2).Value
    Columns("q:t").Clear
End Sub

si tu veux comprendre le cheminement, supprime les 2 dernières lignes du code

    '--- en dur ---
    Range("L4:o" & Lg2) = Range("L4:o" & Lg2).Value
    Columns("q:t").Clear

Amicalement

Claude

21r-gouet-filtre.zip (23.99 Ko)

Encore moi, j'ai un petit supplément.

Sur mon fichier, en colonne P je voudrais mettre une correspondance de texte correspondant aus articles de le colonne K.

C'est plus facile pour moi d'avoir du texte que des chiffres.

J'ai beaucoup d'articles differends, tous ne sont pas présent dans la colonne C.

Comment faire? Quelle formule utiliser? Il faut peux être lister ma liste complète sur une autre feuille du classeur avec les corespondances et que la recherche se fasse à partir de cette liste?

Merci de votre retour.

René

Bonsoir,

Autre présentation, avec Lots et Dates

si pas çà, envoie les résultats remplis manuellement (enlève le résolu).

Sub FitreDate()
Dim Lg&
    Application.ScreenUpdating = False
    Lg = Range("c" & Rows.Count).End(xlUp).Row + 1
    '--- efface ---
    Range("k4:n" & Lg).ClearContents
    '--- filtre dates ---
    Range("i2") = "=e4>=$i$3"                       'critère
    Range("c3:e" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("i1:i2"), CopyToRange:=Range("k3:m3"), Unique:=False
    Range("i2").ClearContents
    Lg = Range("k" & Rows.Count).End(xlUp).Row
    If Range("k4") = "" Then Exit Sub
    '--- formules ---
    Range("n4:n" & Lg) = "=IF(OR(MID(L4,7,1)*1=1,MID(L4,7,1)*1=2),$n$1,$n$2)"
    Range("m" & Lg + 2) = "Total ="
    Range("n" & Lg + 2) = "=sum(n4:n" & Lg & ")"    'Somme
    '--- en dur ---
    Range("n4:n" & Lg) = Range("n4:n" & Lg).Value
End Sub

Claude

Rechercher des sujets similaires à "realisation macro"