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
| [1] Sub Forecast()
[2]‘Déclaration des variables
[3] Dim ACellB As Range 'cellule active de la feuille Backgrounnd (2)
[4] Dim ACellBRow As Double 'Row dela Cellule activede la feuille Backgrounnd (2)
[5] Dim ACellM As Range 'cellule active de la feuille Match
[6] Dim ACellMRow As Range 'Row dela Cellule activede la feuille Match
[7]
[8] Dim Types As String
[9] 'C1 pourles criteres
[10] Dim C1 As String
[11] Dim C2 As String
[12] 'DFE Data filter Empty
[13] Dim DFE As Double
[14] 'V1 pour le valeur de criteres
[15] Dim V1 As String
[16] Dim V2 As String
[17]
[18] Dim MNbRow As Long 'Nombre de ligne dans Match qui réponde aux critères de background
[19]
[20] Worksheets("Background (2)").Select
[21] Worksheets("Background (2)").AutoFilterMode = False
[22]
[23] With Worksheets("Background (2)")
[24] Set rnData = Range("$A$3:$V$3883")
[25] With rnData
[26] 'exclure toutes les stats avec une qté inférieur à G2
[27] .AutoFilter Field:=7, Criteria1:=">=" & [$G$2] _
[28] , Operator:=xlAnd
[29] 'Compte le nombre de ligne visible
[30] For Each rngarea In .SpecialCells(xlCellTypeVisible).Areas
[31] lcount = lcount + rngarea.Rows.Count
[32] Next
[33]
[34] End With
[35]
[36] End With
[37]
[38] If lcount <> 0 Then
[39] 'Descendre à la première ligne visible
[40] Range("Q4", Cells(Rows.Count, "Q").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
[41]
[42] Else
[43] 'sinon va au critère R2 exécuter le forecast
[44]
[45] End If
[46] 'enregistrer les coordonnées de la cellule visible&active
[47] Set ACellB = ActiveCell
[48] ACellBRow = ActiveCell.Row
[49]
[50] 'Filtre le criterion sur sheet match
[51] C1 = ACellB.Offset(0, -14).Value
[52] V1 = ACellB.Offset(0, -13).Value
[53] C2 = ACellB.Offset(0, -12).Value
[54] V2 = ACellB.Offset(0, -11).Value
[55]
[56] 'Coller les valeurs des critère-Background (2) dans le filtre des criteres-Match
[57] Worksheets("Match").Range("$A$1:$AK$100").AutoFilter Field:=14, Criteria1:=C1 _
[58] , Operator:=xlAnd
[59] Worksheets("Match").Range("$A$1:$AK$100").AutoFilter Field:=16, Criteria1:=V1 _
[60] , Operator:=xlAnd
[61] 'Verifier si après application des filtres automatique des matchs répondent au valeurs de critères
[62] Worksheets("Match").Select
[63] MNbRow = Worksheets("Match").Range("$A$1:$AK$100").Columns(3).SpecialCells(xlCellTypeVisible).Count - 1 'pour ne pas compter la
[64] ligne des titres
[65] If MNbRow = 0 Then
[66] 'si résultat des filtres dans Match sont vide alors passer à la ligne suivante de Background
[67] 'A developper
[68] Else
[69] 'si des matchs répondent au critères => Descendre à la première ligne visible
[70] Worksheets("Match").Range("E2", Cells(Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
[71] 'enregistrer les coordonnées de la cellule visible&active de la sheet Match
[72] Set ACellM = ActiveCell
[73] ACellMRow = ActiveCell.Row
[74]
[75] 'Récupérer la valeur F1 de la cellule active feuille 1-Background (2)
[76] 'Additioner la valeur résulatat domicile-colonneN de la cellule active feuille 1-Background (2) dans la cellule active feuille 2 (Match) colonne E
[77] With Range("E" & ACellMRow)
[78] .Value = Range("E" & ACellMRow).Value + ACellB.Offset(0, -3).Value
[79] End With
[80]
[81] 'Descendre à la deuxième ligne visible suivante de la feuille Match si un match est présent.
[82]
[83] End If
[84]
[85]
[86] End Sub |
Filte automatique: Descendre à la ligne visible suivante si valeur présente
.
Répondre avec citation
Envoyé par jbonneval
Partager