CA à date identique

Question

Je ne sais pas si mon titre est explicite mais je m'explique. J'ai des pièces qui sont vendues et je voudrais faire le tri par rapport aux vendeurs et selon une date précise. Je distingue deux sortes de ventes par deux feuilles (gamme différentes). Un exemple de base serait je pense une meilleur explication que mes écrits. Si vous avez une piste, merci pour votre retour. Je suis un tout jeune débutant en VBA et je ne sais même pas comment commencer. Merci pour vos idées...

ThauThème · Accepted Answer

Bonjour le fil, bonjour le forum,

Une autre proposition VBA. En pièce jointe ton fichier modifié avec la macro événementielle Change ci-dessous :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim DR As Date 'déclare la variable DR (Date de Référence)
Dim V As String 'déclare la variable V (Vendeur)
Dim O As Byte 'déclare la variable O (Onglet)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

If Application.Intersect(Target, Range("B1:B2")) Is Nothing Then Exit Sub
Range("A4").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes valeurs
If Application.WorksheetFunction.CountA(Range("B1:B2")) <> 2 Then Exit Sub
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
DR = DateSerial(Year(Range("B2").Value), Month(Range("B2").Value), Day(Range("B2").Value)) 'définit la date de référence DR (génère une erreur si la date n'est pas valide)
If Err > 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    MsgBox "La date n'est pas valide !" 'message
    Range("B2").Select 'sélectionne la cellule B2
    Exit Sub 'sort de la procédure
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
V = Range("B1").Value 'de'finit le vendeur V
K = 1 'initialise la variable K
For O = 1 To 2 'boucle 1 : sur les onglets O de 1 à 2
    TV = Worksheets(O).Range("A2").CurrentRegion 'définit la tableau des valeur TV
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        'condition : si la date et le vendeur (converti en majuscules) de la ligne correspondent à la date de référence DR et au vendeur V
        If UCase(TV(I, 4)) = V And DateSerial(Year(TV(I, 5)), Month(TV(I, 5)), Day(TV(I, 5))) = DR Then
            ReDim Preserve TL(1 To 5, 1 To K) 'redimensionne le tableau de lignes TL (5 lignes, K colonnes)
            For L = 1 To UBound(TV, 2) 'boucle 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=> transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next O 'prochain onglet de la boucle 1
'si K est supérieure à 1, renvoie dans A5 redimensionnée de l'ongelt OE le tableau TL transposé
If K > 1 Then Range("A5").Resize(K - 1, 5).Value = Application.Transpose(TL)
End Sub

Attention, dans les tableaux des ventes tu as un vendeur "b" et dans Extract il est "B"... Mais j'espère que dans ton vrai fichier tu auras la même validation de données pour les vendeurs...

10tespark-ep-v01.xlsm (26.43 Ko)

Zebulon2 · Answer

Une proposition avec Power Query. Cordialement...