Discussion :

[Didpa]

Bonjour

Voilà cela fait deux jours que je cherche et je ne trouve pas tout a fait la solution que je veux.

Je ne sais même pas comment je vais pouvoir expliquer cela.....

La première partie du code fonctionne. c'est après que je bloque.

Quand il a trouvé la date, il doit vérifier que La cellule est vide

si oui il vérifie si la référence est dispo pendant tous les jours de location (Variable i)
Si tous les jours Dispo on repart de la date de départ, et on inscrit un "s"(k) dans chaque cellule des jours de loc.
Ensuite on passe à la référence suivante (j) (Cela me permet de connaitre la référence qui sort la cde peux s'effectuer sur plusieurs référence de la même famille.) donc je dois vérifier la disponibilité de chaque référence a chaque fois.

J'espère avoir été Clair.

Cordialement

si non il descend d'une ligne jusqu' à la prochaine cellule vide ensuite il reférifie la dispo pendant tous les jours de locations

[Invité]

Bonjour,

Bonjour

J'espère avoir été Clair.

Cordialement

Non, pas beaucoup

Il faudrai mettre un bout de code pour bien faire (avec quelques explications sur les lignes de code importantes).

A+

[Didpa]

Bonjour

Désolé voici le fichier

Cordialement

[SMBeccaria]

Bonjour,

Je ne sais pas trop ce que vous souhaitez faire, mais j'ai débloqué votre procédure dans un premier temps:

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
 
 
Sub Ref3x3()
Dim TheDate As Long, Index As Variant
Application.ScreenUpdating = False
Dim RngMyDateCde As Range
Dim DateCde As Date
 
Worksheets("chapiteaux").Activate
 
 
codeChap = "3x3" 'Code AGLM
DateCde = Range("A2")
DatRet = Range("B2")
temps = Range("C2")
 
'If Comment.TB3 = "" Then
'Else
 
   Set codeChap = Range("A5:A100").Find(what:=codeChap)
   If codeChap Is Nothing Then
        MsgBox "Pas trouvé"
    Else
        'MsgBox CodeChap.Address '.Offset(1, 0).Cells(3, 1).Select
    End If
 
 
'--------------------Recherche Date du début pour déduire le stock le temps de la cde---------------------------------------
Set RngMyDateCde = Range("C5:IV5").Find(what:=DateCde)
   If RngMyDateCde Is Nothing Then
        MsgBox "Pas trouvé"
    Else
        RngMyDateCde.Select
    End If
 
 
'---------------------------Sélectionne la cellule à l'intersection Ligne/Colonne----------
 
Set RngMyDateCde = ActiveCell
col = RngMyDateCde.Column
 
Set Chap = Range("A7:A100").Find(codeChap)
Ligne = Chap.Row
Cells(Ligne, col).Select
'Rempli le calendrier des sorties
'Stop
 
For i = 1 To 5
'Stop
For j = 1 To temps
    'MsgBox j
    If ActiveCell = "" Then
     ActiveCell.Offset(0, 1).Select
    Else
        If j = 1 Then
        Do While Not (IsEmpty(ActiveCell)) 'Boucle jusqu'a la prochaine cellule vide
            Selection.Offset(1, 0).Select
        Loop
        Else
            ActiveCell.Offset(0, (-j + 1)).Select
            ActiveCell.Offset(1, 0).Select
        Do While Not (IsEmpty(ActiveCell)) 'Boucle jusqu'a la prochaine cellule vide
            Selection.Offset(1, 0).Select
        Loop
        End If
    End If
 
Next j
 
'Stop
    ActiveCell.Offset(0, (-j + 1)).Select
 
   'If (j - 1) = temps Then
            For k = 1 To 4
                ActiveCell = "S"
                ActiveCell.Offset(0, 1).Select
            Next k
                ActiveCell.Offset(0, (-k + 1)).Select
                ActiveCell.Offset(1, 0).Select
 
Next i
 
End Sub

si la proc ne procure pas l'effet escompté, merci de donner un peu plus d'élément

[Didpa]

Cela ne fonctionne pas comme je le désire, je vais essayer d'être plus clair dans mes explications.

Exemple :J'ai besoin de 4 Référence de la famille des 3x3 a partir du 11 jusqu'au 15, donc 4 jours de Location

je vérifie la disponibilité de la première référence (ici : 3140)

2 Cas se présentent

1/ le 11 cette référence est disponible
mais il faut que je vérifie sa disponibilité le 12, 13, et le 14 si dispo les quatre date je réserve cette référence en notant un "s" dans chaque cellule.
1-1 la référence n'est pas dispo, pendant les 4 jours je vérifie la référence suivante a partir du 11 et ainsi de suite.

2/ La référence n'est pas dispo le 11, je passe à la référence suivante qui est dispo. et je recommence à 1.

Voilà j'espère avoir été plus claire.

Cordialement

[SMBeccaria]

essayons ce code:

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
 
 
Const ShSizeRowD = 7
Const ShSizeRowE = 13
Const MidSizeRowD = 15
Const MidSizeRowE = 26
Const LgSizeRowD = 28
Const LgSizeRowE = 89
Const MegaSizeRowD = 91
Const MegaSizeRowE = 98
 
Sub Ref3x3()
 
    Dim TheDate As Long, Index As Variant
    Dim RgDateFree As Boolean
    Application.ScreenUpdating = False
    Dim RngMyDateCde As Range
    Dim DateCde As Date
    Dim rowD As Integer, rowE As Integer
    Dim codeChap As String
 
    Worksheets("chapiteaux").Activate
 
    codeChap = "4x4" 'Code AGLM
    DateCde = Range("A2")
    DatRet = Range("B2")
    temps = Range("C2")
    '--------------------Recherche Date du début pour déduire le stock le temps de la cde---------------------------------------
    Set RngMyDateCde = Range("C5:IV5").Find(what:=DateCde)
       If RngMyDateCde Is Nothing Then
            MsgBox "La date souhaitée ne fait pas partie du scope"
       Else
            RngMyDateCde.Select
       End If
    '---------------------------Sélectionne la cellule à l'intersection Ligne/Colonne----------
    Set RngMyDateCde = ActiveCell
    col = RngMyDateCde.Column
    Select Case codeChap
     Case "3x3":
        rowD = ShSizeRowD
        rowE = ShSizeRowE
     Case "4x4":
        rowD = MidSizeRowD
        rowE = MidSizeRowE
     Case "5x5":
        rowD = LgSizeRowD
        rowE = LgSizeRowE
     Case "6x6":
        rowD = MegaSizeRowD
        rowE = MegaSizeRowE
    End Select
 
 
    For i = rowD To rowE
        RgDateFree = True
        For j = col To col + temps
            If Cells(i, j) <> "" Then RgDateFree = False
        Next j
        If RgDateFree = True Then
            Range(Cells(i, col), Cells(i, col + temps)) = "S"
            Exit For
        End If
    Next i
 
End Sub

[Didpa]

Je voudrais commencer par te remercier SMBeccaria pour de t'être intéressé à mon problème.

Cela fonctionne je ne comprend pas ton code mais cela fonctionne....lol
(Je vais m'y intéressé après)
il faudrait rajouter une variable a ce code qui est déterminer par le nombre de référence commandée ce jour là.
Pour l'exemple je l'ai rajouté en "K2"

Merci encore à toi.

[Didpa]

Bonjour

Les boucles fonctionnent correctement.

Maintenant et là je n'ai même pas un départ de solution, j'aimerais recupérer la valeur de la référence de la ligne ou l'on inscrit le "s", et l'importer dans une colonne diers peut-être afin de récuperer les donner dans une Listbox dans un userform.

Et également dans les cellules ou j'inscrit le "s" ajouter un commentaire qui est le nom du client "Coment.TB_Nom"

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
Const ShSizeRowD = 7
Const ShSizeRowE = 13
 
Sub Ref3x3()
 
    Dim TheDate As Long, Index As Variant
    Dim RgDateFree As Boolean
    Application.ScreenUpdating = False
    Dim RngMyDateCde As Range
    Dim DateCde As Date
    Dim rowD As Integer, rowE As Integer
    Dim codeChap As String
 
    Worksheets("chapiteaux").Activate
 
    codeChap = "3x3" 'Code AGLM
    DateCde = Range("A2")
    DatRet = Range("B2")
    temps = Range("C2")
    NbreChap = Comment.TB3
    '--------------------Recherche Date du début pour déduire le stock le temps de la cde---------------------------------------
    Set RngMyDateCde = Range("C5:IV5").Find(What:=Format(CDate(DateCde), "d"), LookIn:=xlValues)
       If RngMyDateCde Is Nothing Then
            MsgBox "La date souhaitée ne fait pas partie du scope"
       Else
            RngMyDateCde.Select
       End If
    '---------------------------Sélectionne la cellule à l'intersection Ligne/Colonne----------
    Set RngMyDateCde = ActiveCell
    col = RngMyDateCde.Column
    Select Case codeChap
     Case "3x3":
        rowD = ShSizeRowD
        rowE = ShSizeRowE
    End Select
 
 For k = 1 To NbreChap
    For i = rowD To rowE
        RgDateFree = True
        For j = col To col + temps
            If Cells(i, j) <> "" Then RgDateFree = False
        Next j
        If RgDateFree = True Then
            Range(Cells(i, col), Cells(i, col + temps)) = "S"
 
            Exit For
        End If
    Next i
Next k
End Sub

[Didpa]

Désolé j'ai posté le sujet plus vite que prévu....

Encore Merci, à tout ceux qui se penche dessus

Cordialement

Didier