Discussion :

[jackito]

Bonjour a tous,
Comme l'indique le titre je suis novice en code vba, et je souhaiterai avoir un coup de main sur un code:
Le xlsm se compose de 2 onglets:
onglets 1:



onglets 2:



L'objectif est de remplir l'onglet2 par balayage en faisant pour une même ref et sur la même période:
ressource - conso jusqu’à atteindre le seuil quand le seuil est atteint (on incremente de 1 le nombre de reappro ) puis on continu a retranché la conso pendant le nombre de mois que dure le tps d'approvisionnement.
Lorsque le delais d'appro est atteint on ajoute le multiple de commande . . . sur toute la plage de tps puis on passe a la ref suivante.

Pour l'instant mon code est le suivant (ca vaut ce que ca vaut):

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
Sub nouveau()
Dim i, j As Integer
Dim cond1, cond2, cond3 As Double
Dim cellule, plage, multiple_cde, seuil As Range
'Initialiser a zero le tableau de valeurs a traiter
On Error Resume Next
    Set plage = Application.InputBox("Selection de la plage de cellules a initialiser à zéro:", "Sélectionnez la plage de cellules à initialiser a zéro:", Type:=8)
    On Error GoTo 0
    If plage Is Nothing Then MsgBox "Sélection annulée"
    plage.Value = "0"
'Initialisation des colonnes de frottement
'On Error Resume Next
 '   Set multiple_cde = Application.InputBox("Selection de la colonne de valeur multiple_cde:", "Sélectionnez la colonne plage de multiple_cde:", Type:=8)
  '  On Error GoTo 0
   ' If ressource Is Nothing Then MsgBox "Sélection multiple_cde annulée"
'On Error Resume Next
 '   Set seuil = Application.InputBox("Selection de la colonne de valeur seuil:", "Sélectionnez la colonne plage de seuil:", Type:=8)
  '  On Error GoTo 0
   ' If ressource Is Nothing Then MsgBox "Sélection seuil annulée"
'Boucle de remplissage de zone de traitement
For Each cellule In plage
indice_ligne = cellule.Row
indice_colonne = cellule.Column
 
cond1 = Cells(indice_ligne, 1).Value
cond2 = Cells(1, indice_colonne).Value
'cellule.Value = Evaluate("index(Feuil1!b2:t50,match(1,(Feuil1!a1:a5000=""" & cond1 & """)*(Feuil1!a1:t1=""" & cond2 & """),0))")
 
 
Next
End Sub

[Invité]

Bonjour,
je serai plus alaise avec un fichier.
tu parle de mettre à jour l'onglet 2 et c'est la zone de sélection que tu remet a zéro?

[jackito]

Bonjour rdurupt,
merci d'avoir daigné répondre
la zone de traitement qui correspond aussi a la zone que je mets a zero au début du code est feuil2! range("F2:X31")
J'ai préféré travaillé par zone car le vrai fichier compte 3000lignes / 80 colonnes, donc ca me permets d'actualiser une référence au choix sans avoir a tout re-mouliner.
Feuil3 tu trouvera un exemple sur 2 ref de ce que doit donner en sortie le remplissage.

Nouveau Feuille de calcul Microsoft Excel.xlsm

[Invité]

désolé mais mon employeur en à cure!

Bonjour rdurupt,
merci d'avoir daigné répondre

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
Sub nouveau() 'Traitement Pour la Feuil2 si tu inverse Feuill1 adapte le code.
Dim i, j As Integer
Dim cond1, cond2, cond3 As Double
Dim cellule, plage As Range, multiple_cde, seuil As Range
'Initialiser a zero le tableau de valeurs a traiter
On Error Resume Next
    Set plage = Application.InputBox("Selection de la plage de cellules a initialiser à zéro:", "Sélectionnez la plage de cellules à initialiser a zéro:", Type:=8)
    On Error GoTo 0
    If plage Is Nothing Then MsgBox "Sélection annulée"
    plage.Value = "0"
For L = 1 To plage.Rows.Count
    For C = 1 To plage.Columns.Count
        plage(L, C) = RéférenceDate(ActiveSheet.Cells(plage(L, C).Row, 1), ActiveSheet.Cells(1, plage(L, C).Column), "Feuil1", "A", RetourneColonne("Feuil1", ActiveSheet.Cells(1, plage(L, C).Column)), RetourneColonne("Feuil1", ActiveSheet.Cells(1, plage(L, C).Column)))
    Next
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 > 0 Then
If UCase(Trim("" & Sheets(Feuille).Cells(1, LadateC))) = UCase(Trim("" & Ladate)) Then RéférenceDate = RéférenceDate + CDbl(Sheets(Feuille).Cells(L, RetournC))
End If
Loop
End Function
Function RetourneColonne(Feuille As String, Nom As String) As String
Dim C As Long
For C = 1 To Sheets(Feuille).UsedRange.Columns.Count
    If Sheets(Feuille).Cells(1, C) = Nom Then RetourneColonne = Split(Sheets(Feuille).Cells(1, C).Address, "$")(1): Exit Function
Next
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

Edite: on dirait que cette foie c'est toi qui ne daigne pas lire la réponse!

[jackito]

Bonjour rdurupt,

Merci pour ce code:
Le code se comporte comme un index equiv a l’exécution,
je m'attendais pas a un code aussi complexe, je t’avouerai que j'y comprends pas grand chose:
le:"plage(L,C)= . . . " je comprend pas comment le terme de droite fonctionne
je comprend pas non plus les fonction ucase, serchxls, trim . . .
Peux tu ajouter des commentaires pour que je puisse comprendre.

Je souhaite simuler l’évolution d'un stock zone a remplir (onglet 2 F2:X31), en me basant sur les consommations constatées onglets1.
Le principe c'est: onglet1 j'ai des conso constatées, onglets2 j'ai des ressources (colonne E), et j'y applique 2 paramètres (seuil_sécu de déclenchement de commande et multiple de commande).
Pour une ref ressources je retranche mois par mois mes consommations (onglets1), jusqu'a atteindre le seuil_sécu de déclenchement de commande, qd il est atteint j’incrémente de 1 colonne (Y), et j'attends le délais d'appro colonne(B) pour comptabiliser la commande. Cette commande sera de N fois le multiple d'appro (N étant le plus petit entier permettant de repasser au dessus du seuil_sécu)

Par exemple pour la ref1: pour remplir la case F2, on ferra:
Ressource (E2) - conso du mois puis on passera a G2 (G2=F2-conso(ref1/mois2)),puis H2 (H2=G2-conso(ref1/mois3)) etc . . . . jusqu'a atteindre la valeur de seuil de la ref1 quand cette valeur est atteinte (dans notre cas valeur C2 donc 6), on incrémente de (Y2=+1) puis on continu a retrancher la conso pendant le délais d'appro (B2 ici 1 mois) où on viendra ajouter le multiple d'appro (D2).
Avant de partir dans le calcul serait-il possible de m'expliquer les fonctions dont je t'ai parlé plus haut: ucase/ serchxls / trim ainsi que succinctement le fonctionnement, je souhaite participer.
Merci en tout cas . . . de prendre le temps je sais que je suis pas facile du fait de mes connaissances limitées en VBA.

[eric4459]

Jackito,

je comprend pas non plus les fonction ucase, serchxls, trim

Quand tu visualise ton code et que tu ne saisis pas un terme, il y a l'aide de VBA qui est très utile, j'ai moi même mis du temps avant de l'utiliser.
Pointe ta souris sur le terme et appui sur F1 , l'aide apparaîtra et tu pourras y trouver les explications nécessaires à la compréhension.
Cette méthode aurait pu t'aider pour Ucase et Trim, pour SerchXLs, il s'agit du nom de la fonction crée par Robert.
En VBA tu peux écrire du code mais également créer des fonctions (par exemple des actions qui se répètent plusieurs fois dans ta macro seront codées dans une fonction que tu appelleras depuis ton code lorsque ce sera nécessaire )

Ici Robert a créé la fonction

Code :

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

1
2
3
4
5
6
7
8
9
10
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

Ici , il appele la fonction

Code :

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

1
2
Do While L > 0
L = SerchXls(Sheets(Feuille).Range(ReffC & ":" & ReffC), Sheets(Feuille).Range(ReffC & L), Reff, True)

Eric