Définir un Range selon min et max

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous.

J'ai actuellement ce code qui marche :

Code:

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
 
Sub getCashFlow()
 
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
 
l = InputBox("Veuillez saisir la valeur de la première ligne de biditem", "Sélection de la plage de calcul", "XX") 'Selection de la PREMIERE ligne de biditem de la liste à traiter
k = InputBox("Veuillez saisir la valeur de la dernière ligne de biditem", "Sélection de la plage de calcul", "XX") 'Selection de la DERNIERE ligne de biditem de la liste à traiter
m = InputBox("Veuillez saisir la valeur de la première colonne du calendrier", "Sélection de la plage de calcul", "XX") 'Selection de la PREMIERE colonne du calendrier
n = InputBox("Veuillez saisir la valeur de la dernière colonne du calendrier", "Sélection de la plage de calcul", "XX") 'Selection de la DERNIERE colonne du calendrier
 
 
For i = l To k
 
        If Cells(i, 16).Value <> 0 Then 'Si MODIFY<> 0, faire tourner getCalendar puis getPrice
            Range(Cells(i, m), Cells(i, n)).ClearContents 'Supprimer données de la ligne
            For j = m To n  'PUIS faire tourner getCalendar puis getPrice sur la ligne
            Call getCalendar(i, j)
            Call getPrice(i, j)
            Next j
 
 
        Else 'Sinon, aucune action
            For j = m To n
            Cells(i, j) = Cells(i, j)
            Next j
 
        End If
 
 
Next i
 
End Sub 'Fin du programme
 
 
Sub getCalendar(i As Integer, j As Integer)
 
'Regarde si la date de la cellule sélectionnée est comprise entre la date de début et la date de fin du biditem de la même ligne. Si oui, attribution d'un "x" ou d'un "o"; si non, aucune action
 
        If Cells(12, j).Value >= WorksheetFunction.Min(Cells(i, 9).Value, Cells(i, 10).Value) And Cells(12, j).Value <= WorksheetFunction.Max(Cells(i, 9).Value, Cells(i, 10).Value) Then 'VERIFIER que cette ligne utilise bien les colonnes "START DATE" et "FINISH DATE")
            If Cells(i, 15).Value = "A" Then f = 2 'Vérifier que l'on regarde avec la valeur de CALENDAR UPDATE !
            If Cells(i, 15).Value = "B" Then f = 3 'Vérifier que l'on regarde avec la valeur de CALENDAR UPDATE !
            If Cells(i, 15).Value = "C" Then f = 4 'Vérifier que l'on regarde avec la valeur de CALENDAR UPDATE !  'différentes valeurs de f à màj'
            Cells(i, j).Value = Application.VLookup(Cells(12, j), Sheets("Calendar").Range("D6:G370"), f, True) 'vérifier limite du tableau pour le vlookup
 
 
        Else: Cells(i, j).Value = Cells(i, j).Value
 
        End If
 
 
End Sub
 
 
 
 
 
Sub getPrice(i As Integer, j As Integer)
'Regarde si la date de la cellule sélectionnée est comprise entre la date de début et la date de fin du biditem de la même ligne ET que la cellule sélectionnée ne contient pas "x". Si oui, attribution du daily price; si non, aucune action
 
        If Cells(12, j).Value >= WorksheetFunction.Min(Cells(i, 9).Value, Cells(i, 10).Value) And Cells(12, j).Value <= WorksheetFunction.Max(Cells(i, 9).Value, Cells(i, 10).Value) And Cells(i, j).Value <> "x" Then 'VERIFIER que cette ligne utilise bien les colonnes "START DATE" et "FINISH DATE")
        Cells(i, j).Value = Cells(i, 18).Value 'VERIFIER que cette ligne renvoie bien à la colonne "Daily Price"'
 
        Else: Cells(i, j).Value = Cells(i, j).Value
 
        End If
 
End Sub

Le problème de ce code est qu'il est trop lent. En effet, dans mon cas, m=20 et n=2576. Donc dix lignes prennent genre plus de 1 minutes (et je dois en traiter beauuuuucoup plus à terme)

Ma question est : puis-je faire en sorte que mon programme ne parcourt PAS les 2556 colonnes pour chaque ligne ?

Je pensais passer par une fonction "For Each ... in Range" mais je ne maîtrise pas bien cette fonction.

Serait-il possible d'écrire quelque chose comme :

1)

Code:

1
2
3
4
5
 
 
Set myRange = Sheets("BidItem Cost Details").Range(Cells(12, m), Cells(12, n))
For Each cell In myRange
If cell.Value > Sheets("BidItem Cost Details").Min(Cells(i, 10).Value, Cells(i, 11).Value) And cell.Value < Sheets("BidItem Cost Details").Max(Cells(i, 10).Value, Cells(i, 11).Value)) Then

puis faire tourner getCalendar et getPrice pour les cellules (de la ième ligne) dans l'intervalle.
Mais cela sera-t-il plus rapide ?

2) Faire un Range qui varie à chaque ligne (définit par les bornes de "Start Date" et "Finish Date") ? Mais je ne sais pas si c'est possible avec ce type d'objet.

Par exemple :

Code:

1
2
3
4
5
6
7
8
9
10
 
 
For i = l To k
 
        If Cells(i, 16).Value <> 0 Then 
            Range(Cells(i, m), Cells(i, n)).ClearContents 'Supprimer données de la ligne
            Set myRange = (Min(Cells(i, 10).Value, Cells(i, 11).Value), Max(Cells(i, 10).Value, Cells(i, 11).Value))
            For Each cell in myRange
 
             'PUIS faire tourner getCalendar puis getPrice sur la i-ème ligne et les colonnes des "cell" en question

Je vous joins le fichier en espérant que vous y voyez plus clair !

Un grand merci à tous les courageux qui auront pris le temps de me lire et de se pencher sur la question !
Très bonne journée,
Jean-Etienne.

Pièce jointe 284307

11/06/2017, 21h50
mjpmjp

bonjour,
je te vois partir sur une méchante galère :nono:

tu as un calendrier (plusieurs années) vertical et horizontal...

question
un seul vertical est il possible ?
un onglet par année ?

autre chose
tu teste des dates ( à chaque ligne ?) --> astuce : les jours se suivent , seul le 28/29 février est un obstacle minime
tu peux donc calculer exactement la ligne (verticale) qui correspond à un jour (date départ et date fin)
et ainsi ne plus "tester" et "perdre du temps"

@+JP

Bonjour mjpmjp.

Pour les calendriers verticaux et horizontaux, tu parles du calendrier du premier onglet versus ceux du deuxième onglet ?
Je peux mettre ceux du deuxième onglet horizontaux si nécessaire mais à date cela n'a jamais posé de problème (pour la recherche de "si c'est un jour travaillé ou non").
(J'espère avoir bien compris ta question).

Pour ta deuxième idée, je t'avoue ne pas avoir très bien compris ce que tu me suggères ^^

J'ai depuis la dernière fois changé mon code mais je ne comprends pas pourquoi il ne marche pas ....
Lors du premier passage il marche parfaitement : ma "val_debut" et "val_fin" prennent les bonnes valeurs. Mais dès que je passe à la deuxième ligne (i=14), ma "Valeur_Cherchee_Fin" n'est plus reconnue et "val_fin" prend la valeur "Nothing"....

Un grand merci pour vos lumières; ca fait deux jours que je bloque là-dessus !

Jean-Etienne

Code:

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
 
Option Explicit
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
Dim f As Integer
Dim start As Single
 
 
Sub getCashFlow()
 
Dim val_debut As Range, val_fin As Range, PlageDeRecherche As Range, PlageDeRecherche2 As Range
Dim Valeur_Cherchee_deb As Date
Dim Valeur_Cherchee_fin As Date
Dim rCell As Range
 
 
 
 
l = InputBox("Veuillez saisir la valeur de la première ligne de biditem", "Sélection de la plage de calcul", "XX") 'Selection de la PREMIERE ligne de biditem de la liste à traiter
k = InputBox("Veuillez saisir la valeur de la dernière ligne de biditem", "Sélection de la plage de calcul", "XX") 'Selection de la DERNIERE ligne de biditem de la liste à traiter
m = InputBox("Veuillez saisir la valeur de la première colonne du calendrier", "Sélection de la plage de calcul", "XX") 'Selection de la PREMIERE colonne du calendrier
n = InputBox("Veuillez saisir la valeur de la dernière colonne du calendrier", "Sélection de la plage de calcul", "XX") 'Selection de la DERNIERE colonne du calendrier
 
Set PlageDeRecherche = Range(Cells(12, m), Cells(12, n))
Sheets("BidItem Cost Details").Select
 
 
 
For i = l To k
 
        If Cells(i, 17).Value <> 0 Then 'VÉRIFIER QUE CETTE LIGNE RÉFÈRE A LA COLONNE MODIFY ; Si MODIFY<> 0, faire tourner getCalendar puis getPrice
            Range(Cells(i, m), Cells(i, n)).ClearContents 'Supprimer données de toute la ligne
            Valeur_Cherchee_deb = Cells(i, 10).Value
            Valeur_Cherchee_fin = Cells(i, 11).Value
 
            Set val_debut = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee_deb, LookAt:=xlWhole, SearchOrder:=xlByColumns)
            Set val_fin = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee_fin, LookAt:=xlWhole, SearchOrder:=xlByColumns)
 
                If val_debut Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvé
 
                ElseIf val_fin Is Nothing Then 'ici, traitement pour le cas où la valeur n'est pas trouvé
 
                Else  'ici, traitement pour le cas où la valeur est trouvée
                Set PlageDeRecherche2 = Range(val_debut, val_fin)
                For Each rCell In PlageDeRecherche2
                rCell.Offset(l - i + 1, 0).Value = 10
'                   Set PlageDeRecherche2 = Range(val_debut, val_fin)
'                   For Each rCell In PlageDeRecherche2
'                    If Cells(i, 15).Value = "A" Then f = 2 'Vérifier que l'on regarde avec la valeur de CALENDAR  !
'                    If Cells(i, 15).Value = "B" Then f = 3 'Vérifier que l'on regarde avec la valeur de CALENDAR  !
'                    If Cells(i, 15).Value = "C" Then f = 4 'Vérifier que l'on regarde avec la valeur de CALENDAR  !  'différentes valeurs de f à màj'
'                   rCell.Offset(12 + i, 0).Value = Application.VLookup(rCell, Sheets("Calendar").Range("D6:G370"), f, True)
'                        If rCell.Value <> "x" Then 'VERIFIER que cette ligne utilise bien les colonnes "START DATE" et "FINISH DATE")
'                        rCell.Value = Cells(i, 20).Value 'VERIFIER que cette ligne renvoie bien à la colonne "Daily Price"'
'                        Else
'                        End If
'
                    Next rCell
                End If
 
 
           Else
 
           End If
 
'        Call fillCheck(i) 'Remplissage de CALENDAR UPDATE et MODIFY
 
Next i
 
 
 
End Sub 'Fin du programme

12/06/2017, 21h50
mjpmjp
bonjour,

Citation:

Mais dès que je passe à la deuxième ligne (i=14), ma "Valeur_Cherchee_Fin" n'est plus reconnue et "val_fin" prend la valeur "Nothing"....

est ce que l'erreur est ICI ? (la plage n'a qu'une ligne 12)
Code:

1 2 Set PlageDeRecherche = Range(Cells(12, m), Cells(12, n))
@+JP