Fonction personnalisée

[cibleo]

Bonsoir le forum,

J'aimeras créer une fonction personnalisée que je placerai dans les cellules de la colonne N de la feuille "Synthese"

Le but : calculer un horaire de prise des service à partir de la 1ère cellule non vide figurant dans la plage (C:M) en faisant référence à la table de concordance située dans la feuille "Delai".

Cliquer sur le Bouton rouge pour voir le résultat que j'aimerais obtenir.

Dans mon exemple, j'ai pris en compte la ligne 3.
Extrait 08:30 puis "Pont sur Vanne" et effectuer le calcul suivant :
08:30 - 00:40 = 07:50
Ainsi en N3, j'aimerais obtenir 07:50 (au format date pour un calcul ultérieur)

Ce que j'ai réalisé est dans le module 1.

Pour info, la feuille "Synthese" est un tableau dynamique et la fonction sera appelée d'un module.

Merci de votre aide et bonne soirée à tous
Cibleo

 

[Compte Supprimé 979]

Re : Fonction personnalisée

Bonjour Cibleo

Tu trouveras ci-joint ton fichier avec 2 fonctions

Function HeureService(Rng As Range, Debut As Boolean)
Dim prenom As String, Journee As String, Lieu As String, Col As Integer, Lig As Long, Pos As Byte
Dim Horaire As Date, PourYParvenir As Date, HService As Date, c As Range
  Application.Volatile  ' Ne pas oublier de mettre cette instruction, pour un recalcul systématique
  
  prenom = "Pascal" 'ComboChauffeurs.Value
  Lig = Rng.Row
  ' Récupère le numéro de colonne selon critère
  If Debut = True Then
    Col = Range("B" & Lig).End(xlToRight).Column
  Else
    Col = Range("N" & Lig).End(xlToLeft).Column
  End If
  '
  If Col >= 13 Or Col <= 2 Then 'colonne M (17:00)
    HService = "00:00"
  Else
    Journee = Cells(Lig, Col)
    Horaire = CDate(Left(Journee, 5))
    Pos = InStr(1, Journee, Chr(10))
    Lieu = Mid(Journee, 7, Pos - 7)
    With Sheets("Delai").Range("A2:A" & Sheets("Delai").Range("A65536").End(xlUp).Row)
      Set c = .Find(Lieu, LookIn:=xlValues, lookat:=xlWhole)
      If Not c Is Nothing Then PourYParvenir = CDate(c.Offset(0, 1))
      
      If Debut = True Then
        HService = Horaire - PourYParvenir
      Else
        HService = Horaire + PourYParvenir
      End If
      
    End With
  End If
  HeureService = HService
End Function

Function LieuEtHeure(Rng As Range, Debut As Boolean)
  Dim Col As Integer, Lig As Long, Pos As Integer
  Application.Volatile  ' Ne pas oublier de mettre cette instruction, pour un recalcul systématique
  
  Lig = Rng.Row
  ' Récupère le numéro de colonne selon critère
  If Debut = True Then
    Col = Range("B" & Lig).End(xlToRight).Column
  Else
    Col = Range("N" & Lig).End(xlToLeft).Column
  End If
  Col = Range("B" & Lig).End(xlToRight).Column
  If Col >= 13 Or Col <= 2 Then
    LieuEtHeure = "-"
  Else
    Pos = InStr(1, Cells(Lig, Col), Chr(10))
    LieuEtHeure = Left(Cells(Lig, Col), Pos - 1)
  End If
End Function

A+

 

[cibleo]

Re : Fonction personnalisée

Bonjour le forum,
Bonjour Bruno,

Je décrypte tes fonctions en colonne N et O et teste dans mon fichier original.
Je reviens plus tard pour donner des nouvelles parce qu'il faut que j'appelle tes fonctions avec une syntaxe de ce genre :

Cells(,) .FormulaR1C1 = "=Ta fonction

Merci Bruno

A+ Cibleo

 

[pierrejean]

Re : Fonction personnalisée

bonjour cibleo

Salut Hulk

Un essai

 Function prise_serv(ligne)
HPriseService = "#Valeur"
X = Cells(ligne, 2).End(xlToRight).Column
If X >= 13 Then
  prise_serv = " Horaire de prise de service fixée à : 00:00"
  Exit Function
End If
y = Left(Cells(ligne, X), 5)
Z = Trim(Replace(Split(Cells(ligne, X), Chr(10))(0), y, ""))
Set c = Sheets("Delai").Range("A2:B" & Sheets("Delai").Range("A65536").End(xlUp).Row).Find(Z, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
  tps = c.Offset(0, 1)
  HPriseService = CDate(y) - tps
End If
prise_serv = "Depart: " & Z & " Horaire de prise de service fixée à : " & HPriseService
End Function

 

[cibleo]

Re : Fonction personnalisée

Bonjour PierreJean,

C'est tout bon, sauf qu'en N6, j'aimerais que cela me renvoie 09:00 au lieu #Valeur comme dans la fonction de Bruno.
En effet, Bondy ne figure pas dand la colonne A feuille "Delai" ce qui arrivera souvent puisque cette liste ne sera pas forcément mise à jour régulièrement.
Donc HPriseService = CDate(y) s'il n'y a pas de correspondance dans la feuille "Delai"

Function prise_serv(ligne)
[COLOR=red]HPriseService = "#Valeur"[/COLOR]
X = Cells(ligne, 2).End(xlToRight).Column
If X >= 13 Then
  prise_serv = ""
  Exit Function
End If
y = Left(Cells(ligne, X), 5)
Z = Trim(Replace(Split(Cells(ligne, X), Chr(10))(0), y, ""))
Set c = Sheets("Delai").Range("A2:B" & Sheets("Delai").Range("A65536").End(xlUp).Row).Find(Z, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
  tps = c.Offset(0, 1)
  HPriseService = CDate(y) - tps
End If
prise_serv = HPriseService
End Function

En colonne O, décliner ta fonction en obtenant exactement le même résultat que Bruno, ça serait parfait

Bruno, j'ai toujours pas intégrer tes fonctions et tester dans mon fichier original
Sinon, pour le résultat obtenu, c'est exactement ça.
En colonnes P et Q, je pense faire une saisie manuelle donc pas de formules, les heures de fin des service sont difficilement calculables.

A+ Cibleo

 

[pierrejean]

Re : Fonction personnalisée

Re

Voila

 

[cibleo]

Re : Fonction personnalisée

Bonsoir à tous,

Je poursuis les tests et essaie de retranscrire les 2 formules en VBA en colonne N comme ceci :
La fonction de pierrejean

'ShtR.Cells(DerLiR, [COLOR=red]14[/COLOR]).FormulaR1C1 = "=prise_serv(row())"

Ou la fonction de Bruno

ShtR.Cells(DerLiR, [COLOR=red]14[/COLOR]).FormulaR1C1 = "=HeureService(RC[-13];true)"

Par rapport à la colonne N, RC[-13] représente bien la colonne A ?

Résultat : la fonction de pierrejean est bien retranscrite mais cela m'affiche #VALEUR!
Je dois avoir une erreur de conversion.

Celle de Bruno, je n'arrive pas à la traduire

Function prise_serv(ligne) 'PierreJean
Dim HPriseService As Date, Z As String, y As String, tps As Date
Dim X As Byte, c As Range
X = Cells(ligne, 2).End(xlToRight).Column
If X >= 13 Then
  [COLOR=blue]prise_serv = "00:00"[/COLOR]
  Exit Function
End If
y = Left(Cells(ligne, X), 5)
HPriseService = CDate(y)
Z = Trim(Replace(Split(Cells(ligne, X), Chr(10))(0), y, ""))
Set c = Sheets("Delai").Range("A2:B" & Sheets("Delai").Range("A65536").End(xlUp).Row).Find(Z, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
  tps = c.Offset(0, 1)
  HPriseService = CDate(y) - tps
End If
[COLOR=blue]prise_serv = HPriseService[/COLOR]
End Function

Pierrejean, j'ai donc modifié ton code. En colonne N, je souhaite voir apparaître qu'un horaire (donc format horaire).

Pouvez-vous intervenir ?
Cibleo

 

[pierrejean]

Re : Fonction personnalisée

Re

A tester:

 ShtR.Cells(DerLiR, [COLOR=red]14[/COLOR]).Formulalocal = "=prise_serv(" & DerLiR & ")"

 

[cibleo]

Re : Fonction personnalisée

Bonjour à tous,
Bonjour PierreJean, Bruno

Après tests :
En colonne O, les 2 syntaxes de la fonction lieu_heure ci-dessous me renvoient bien le résultat escompté (voir illustration)

ShtR.Cells(DerLiR, [COLOR=red]15[/COLOR]).FormulaR1C1 = "=lieu_heure(row())"
'ShtR.Cells(DerLiR, [COLOR=red]15[/COLOR]).FormulaLocal = "=lieu_heure(" & DerLiR & ")"

En colonne N, les 2 syntaxes de la fonction prise_serv me renvoient #VALEUR
Par contre, cela m'affiche bien 00:00 à la dernière ligne lorsque la plage (C:M) est vide.

'ShtR.Cells(DerLiR, [COLOR=blue]14[/COLOR]).FormulaR1C1 = "=prise_serv(row())"
ShtR.Cells(DerLiR, [COLOR=blue]14[/COLOR]).FormulaLocal = "=prise_serv(" & DerLiR & ")"

C'est le format horaire qui doit mettre le bazar
Pour en être certain, il faut que je trouve la syntaxe de la fonction de Bruno (HeureService) et tester.
Je continue mes recherches sur le forum.

A+ Cibleo

 

[pierrejean]

Re : Fonction personnalisée

Re

Je ne comprends pas

Voir le resultat de la macro essai dans le fichier ci-joint

 

[cibleo]

Re : Fonction personnalisée

Bonsoir à tous,
PierreJean, Bruno

J'ai résolu le problème (#Valeur). Dans mon fichier original, la table de concordance ne se trouvait pas dans une feuille nommée "Delai" comme dans le fichier que je vous avais joint.

Mais, j'ai un autre souci. Cliquez sur le bouton vert.
Les résultats affichés dans la zone grise ne sont pas les bons.
Dans la zone rose, c'est Ok.

Dans la configuration des lignes 4 et 5, la 1ère cellule non vide prise en compte est celle de la colonne D au lieu de C.
Par contre en ligne 2 et 3, c'est bien la colonne C qui est pris en compte.
Que ce soit avec la fonction de PierreJean ou Bruno, même résultat erroné.
Pouvez vous vous pencher à nouveau sur mon problème ?

Cibleo

Ps : cliquez aussi sur le bouton rouge.

 

[cibleo]

Re : Fonction personnalisée

Bonsoir le forum,
Bonsoir PierreJean

Les cellules de la plage (C2:M8) sont remplies de façon éparse.
Or si je remplis C4 et D4, l'instruction ci-dessous considérent D4 comme la 1ère cellule remplie et non C4 et me renvoie une mauvaise valeur en N4 et O4.
Si je remplis C4, E4 en laissant vide D4 c'est tout bon.

Je remarque aussi quand laissant vide la plage chauffeurs (B2:B8), ton code fonctionne dans toutes les configurations de remplissage des cellules.

Function prise_servb(ligne) 'PierreJean
.../...
[COLOR=red]X = Cells(ligne, 2).End(xlToRight).Column[/COLOR]
.../...
End Function

Voir le fichier que j'ai remplacé au post #11#

Cibleo

 

[pierrejean]

Re : Fonction personnalisée

Re

Ok
modif effectuée :

If Cells(ligne, 3) = "" Then
 X = Cells(ligne, 2).End(xlToRight).Column
Else
 X = 3
End If

 

[cibleo]

Re : Fonction personnalisée

re à tous,

Merci PierreJean, c'est tout bon maintenant

A bientôt Cibleo