Discussion :

[chafoo]

Bonjour le forum,

Je suis encore dans la panade, ce que je voudrais c'est pouvoir faire une recherche en fonction d'une date et d'une référence "une recherche à double critéres"
A savoir que sur la feuille 1 les date sont dans une colonne et sur la feuille 2 sur une ligne

je joint un petit fichier qui explique ce que je voudrais je pense pas que ce soit difficile a savoir que je voudrais l'intégré a mon code VBA

Merci d'avance à ce qui pour m'apporter des réponses

Pièce jointe 163592

[Invité]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Function RéférenceDate(Reff, Ladate) As Double
Dim L As Long
L = 1
Do While Format(Sheets("Feuil1").Cells(L, 2), "yyyy-mm-dd") <> Format(Ladate, "yyyy-mm-dd")
L = SerchXls(Sheets("Feuil1").Range("A:A"), Sheets("Feuil1").Range("A" & L), Reff, True)
If L < 1 Then Exit Do
If L > 0 And Format(Sheets("Feuil1").Cells(L, 2), "yyyy-mm-dd") = Format(Ladate, "yyyy-mm-dd") Then RéférenceDate = RéférenceDate + CDbl(Sheets("Feuil1").Range("c" & L))
Loop
End Function
 
Function SerchXls(Myrange As Range, MyCellule As Range, strRecherche, EntierCell As Boolean) As Long '
On Error Resume Next
Dim CellEntrier As Integer
If EntierCell = True Then CellEntrier = xlWhole Else CellEntrier = xlPart
SerchXls = 0
   SerchXls = Myrange.Cells.Find(what:=strRecherche, After:=MyCellule, LookIn:=xlFormulas, LookAt _
        :=CellEntrier, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=EntierCell).Row
  If SerchXls <= MyCellule.Row Then SerchXls = 0
End Function

[chafoo]

Merci pour ta réponse très rapide c'est exactement ce que je souhaite,

par contre je suis bloqué le code que tu a réalisé c'est des fonction je dois y faire appelle dans mon code principale je suis entrain de regarder mais pas évident car je ne sais pas utilisé les (fonction/private sub ou autre) dans un module différent et y faire appel à partir d'un autre se serait l'idéal mais je n'arrive pas pourrais tu m'expliquer s'il te plait je te joint le code auquel je veux y faire appel tout!

peut-être pourra tu m’aiguiller

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
'Importation des données de la "Base_art EMC-IMC" vers "J+5"
'=========================================================================================================
 
Sub ImporterDonnees()
 
'Déclaration des compteurs et variables
 
        With Application
        .Calculation = xlManual
        .ScreenUpdating = False
    End With
 
    T = Timer
    Dim classeur As Workbook, WB_Principal As Workbook, Wb As Workbook, Feuil1 As Worksheet, Feuil2 As Worksheet, Ws As Worksheet, wk As Worksheet
    Dim maPlage As Range, maPlage1 As Range, maPlage2 As Range
    Dim DernLigne As Long, DernLigne1 As Long, DernLigne2 As Long, LastLig As Long
 
    ' Amène le classeurs cible en avant plan, celui-ci devient le [ ActiveWorkbook ]
            Set WB_Principal = ActiveWorkbook
        Set Feuil2 = WB_Principal.Worksheets("J+5")
 
 '------------------------------- Suppression des données presente sur la feuille J+5 & du filtre -----------------
 
        Dim NbColonnes As Integer
    NbColonnes = 74
 
    Sheets("J+5").Activate
    Range(Cells(5, 1), Cells(5, NbColonnes)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
 
 
 '------------------------------- Connection à la base "Base_art EMC-IMC"  -----------------
         Application.WindowState = xlNormal
 
' Ouverture du classeur
    Set classeur = Workbooks.Open("C:\Users\chafik\Desktop\personnel Chafik\importation données\Base_art EMC-IMC.xlsx", _
    False, True)
    Set Feuil1 = classeur.Worksheets("Base_art EMC-IMC")
    Rows("1:1").Range("X1").Activate
 
 '----Mise en place d'un filtre et exctraction des données en fonction du "Code gestionnaire"---------------
 
    Selection.AutoFilter
        ActiveSheet.Range("$A$4:$AL$11469").AutoFilter Field:=5, Criteria1:=Array( _
        "190", "191", "192", "193", "194", "195", "196", "197", "198", "199", "280", "289"), Operator _
        :=xlFilterValues
 
 '---- Copie & collage des données d'un classeur vers l'autre ---------------
 
        Range("B2:E65536,G2:H65536,AA2:AA65536").Copy Destination:=Feuil2.Range("A5")
 
                   DernLigne1 = Feuil1.Range("Z" & Rows.Count).End(xlUp).Row
        Set maPlage1 = Feuil1.Range("Z2:Z" & DernLigne1)
                         maPlage1.Copy Destination:=Feuil2.Range("H5")
 
                    DernLigne2 = Feuil1.Range("L" & Rows.Count).End(xlUp).Row
        Set maPlage2 = Feuil1.Range("L2:M" & DernLigne2)
                         maPlage2.Copy Destination:=Feuil2.Range("I5")
 
 
        Feuil1.Range("J2:K65536,AG2:AG65536,AI2:AI65536").Copy Destination:=Feuil2.Range("K5")
 
 
     '---- Mise en place d'un filtre sur les en-têtes des données copier ---------------------------------
 
                    Rows("4:4").Select
    Selection.AutoFilter
 
    CutCopyMode = False
 
  '------------------------------- Fermeture du classeur sans l'enregistrer "Base_art EMC-IMC"  -----------------
 
        Feuil1.Activate
    ActiveWorkbook.Close SaveChanges:=False
 
                Application.DisplayAlerts = 1
 
 
     '------------------------------- Mise en Forme de la premiere ligne -----------------------------------------------
 
    Range("A5,E5,G5,R5,X5,AJ5,AN5,AZ5,BK5,BO5").Style = "Style 1"
    Range("B5:C5,H5:P5,S5:U5,Y5:AH5,AO5:AW5,BA5:BI5,BL5:BM5,BP5:BQ5").Style = "Style 4"
    Range("D5,F5,Q5,V5,AI5,AX5,BJ5,BN5,BR5").Style = "Style 5"
    Range("W5,AJ5,AK5,AL5,AM5,AY5,BS5,BT5,BU5,BV5,BW5").Style = "Style 6"
 
     '--------------- selection de la premiere ligne et copie de la mise en forme sur le tableau variable --------------
            Rows("5:5").Select
    Selection.Copy
    Range(Cells(5, 1), Cells(Cells(65536, 1).End(xlUp)(1).Row, 75)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
 
End Sub

Si jamais tu voit des choses qui te choque n'hésite pas à me faire la remarque je suis débutant et j'utilise souvent l'enregistreur de macro et forum pour arriver à mes fins donc je prend toutes les remarques qui me permette d'avancer !!!

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Myvariable=RéférenceDate([B1], [A1])

[chafoo]

Salut rdurupt,

Je suis entrain de m'arracher les cheveux j'arrive bien a lancé les fonctions comme tu ma expliquer mais apparemment l'exemple que je t'es donné ne doit pas vraiment correspondre à ce que je veux, je t'explique c'est exactement ce que tu ma fait mais avec

une feuil qui s'appelle "APPROS" ou je récupère mes infos colonne (C) les références, colonne (J) les dates et colonne (L) les informations que je veux récupérer ça comme à partir de la ligne 2 et ça peut aller jusqu’à 20.000 lignes et je veux importer ça dans une feuil qui s'appelle "J+5" ou j'ai colonne (B) les référence identique a (C) de l'autre feuille et les dates de la feuil "APPROS" colonnes (J) sont sur plusieurs colonnes dans la feuil "J+5" c'est deux semaine ouvrée ça commence (AZ) et sa fini à (BJ) donc (AZ:BA:BB:BC:BD:BE:BF:BG:BH:BI:BJ) qui sont sur la ligne 4 sinon les référence commence à partir de la ligne 5 et jusqu’à 600 voir plus c'est variable en fonction du nombre référence

j’espère que j'ai été assez clair et que tu me comprendra alala j'aurais du bien expliquer dès le début!

merci encore et bonne soiré j'en peut plus :/

[Invité]

Bonjour,
test cette version!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Test()
Dim L As Long
Dim r As Range
Set r = Sheets("Feuil2").Range(Sheets("Feuil2").Range("A2"), Sheets("Feuil2").Cells(Cells.Rows.Count, 1).End(xlUp))
For L = 1 To r.Rows.Count
    Debug.Print RéférenceDate(r(L, 1), "04/12/2014", "APPROS", "A", "B", "C")
Next
End Sub
Function RéférenceDate(Reff, Ladate, Feuille As String, ReffC As String, LadateC As String, RetournC) As Double
Dim L As Long
L = 1
Do While L > 0
L = SerchXls(Sheets(Feuille).Range(ReffC & ":" & ReffC), Sheets(Feuille).Range(ReffC & L), Reff, True)
If L < 1 Then Exit Do
If L > 0 And Format(Sheets(Feuille).Cells(L, LadateC), "yyyy-mm-dd") = Format(Ladate, "yyyy-mm-dd") Then RéférenceDate = RéférenceDate + CDbl(Sheets(Feuille).Cells(L, RetournC))
Loop
End Function
 
Function SerchXls(Myrange As Range, MyCellule As Range, strRecherche, EntierCell As Boolean) As Long '
On Error Resume Next
Dim CellEntrier As Integer
If EntierCell = True Then CellEntrier = xlWhole Else CellEntrier = xlPart
SerchXls = 0
   SerchXls = Myrange.Cells.Find(what:=strRecherche, After:=MyCellule, LookIn:=xlFormulas, LookAt _
        :=CellEntrier, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=EntierCell).Row
  If SerchXls <= MyCellule.Row Then SerchXls = 0
End Function