insertion ligne excel sous condition

Ricouch

XLDnaute Nouveau
Bonjour,
Lorsque je sélection une date (sur la feuille 2) , je veux que l'ensemble des n°série relatifs à la date sélectionnée et existant dans la Feuille -Source- s'affiche sur le tableau. (Voir pièces jointe).

J’espère que ma question et claire :)

Merci d'avance pour votre aide.
 

Pièces jointes

  • Insertion ligne sous condition.xlsx
    51.4 KB · Affichages: 18

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Ricouch, bonjour le forum,

J'ai du modifier la liste de validation de données de l'onglet Feuil3...
Le code :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim S As Worksheet 'déclare la variable S (onglet Source)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim DL As Long 'déclare la variable DL ()
Dim TS() As Variant 'déclare la variable TS (Tableau des Séries)
Dim DC As Long 'déclare la variable DC (Date Cherchée)
Dim D As Long 'déclare la variable D (Date)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

If Target.Address <> "$F$2" Then Exit Sub 'si le changement a lieu ailleurs qu'en F2, sort de la procédure
Me.Range("C4:C" & Application.Rows.Count).ClearContents 'efface d'éventuelles anciennes recherches
Set S = Worksheets("Source") 'défin it l'onglet S
TV = S.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
DC = CLng(DateSerial(Year(Target.Value), Month(Target.Value), Day(Target.Value))) 'définit la date cherchée (convertie en entier long)
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D = CLng(DateSerial(Year(TV(I, 1)), Month(TV(I, 1)), Day(TV(I, 1)))) 'définit la date D de la boucle (convertie en entier long)
    If DC = D Then 'condition : si les deux date sont identiques
        ReDim Preserve TS(J) 'redimensionne le tableau des séries TS (J lignes)
            TS(J) = TV(I, 2) 'décupère dans la ligne J de TS le numéro de série ligne I colonne 2 de TV
            J = J + 1 'incrémente J
        End If
Next I
'si le nombre d'éléments trouvés est supérieur à 0, rencoie dans C4 redimensionnée le tableau TS ransposé
If J > 0 Then Me.Range("C4").Resize(UBound(TS), 1).Value = Application.Transpose(TS)
End Sub

Le fichier :
 

Pièces jointes

  • Ricouch_v01.xlsm
    63 KB · Affichages: 16

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 305
Messages
2 087 084
Membres
103 459
dernier inscrit
Arnocal