fonction vba d'encadrement

[matis3854]

Bonjour à tous,

Me voici revenue aujourd'hui pour un problème de fonction créée dans vba.
En effet je voudrais créer une fonction qui permet d'encadrer la valeur d'une cellule et de lui attribuer une valeur conséquente de cette encadrement. Le problème c'est que j'effectue mon encadrement avec des variables dont je fais appel dans ma fonction et du coup ma fonction me renvoie tjs 0. Voici mon bout de code :

ublic Function fonction(cell As Range) As Integer

Dim n As Integer
Dim nb As Integer
Dim a As Integer

nb = Range("'informations générales'!c25").Value 'nbre de série de 10 de nombres me permettant d'encadrer ma valeur de cellule

If cell.Value = 0 Then
fonction = 0
End If

n = 5


a = nb * 10 (nombre totale de chiffre permettant de faire mon encadrement)


If cell.Value > 0 And cell.Value < Sheets("bilan charge partielle").Range("b5").Value Then
fonction = Sheets("bilan charge partielle").Range("c5").Value
End If

For i = 2 To a - 1

If cell.Value >= Sheets("bilan charge partielle").Range("b" & n & "").Value And cell.Value < Sheets("bilan charge partielle").Range("b" & n + 1 & "").Value Then
fonction = Sheets("bilan charge partielle").Range("c" & n + 1 & "").Value
End If

n = n + 1

Next

If cell.Value > Sheets("bilan charge partielle").Range("b" & a + 5 & "").Value Then
fonction = Sheets("bilan charge partielle").Range("c" & a + 5 & "").Value
End If


End Function

je ne vois pas ce qui ne marche pas.

 

[matis3854]

Re : fonction vba d'encadrement

bonjour ... une fois de plus,

Il me semble que la demande est assez claire, maintenant. Il te reste à patienter un peu pour qu'un spécialiste de vba puisse mettre ça "en musique" ou en tout cas te donner des pistes à suivre.
En ce qui me concerne, je ne suis qu'un "bricoleur" en vba, c'est pour cela que je disais que je passais la main (d'autres feront ça plus proprement et plus rapidement que moi)

Modeste

Merci bcp en tout cas, ta méthode recherche marche très bien mais elle ne fonctionnera dans mon programme totalement décousu!! lol
je me suis mise au vba ya 2 mois et je dois produire une programme d'analyse énergétique autant te dire que c pas simple, ms merci bcp à ts les gens présents ici qui donne un peu de leur tps pr répondre à nos questions!!

 

[ROGER2327]

Re : fonction vba d'encadrement

Bonjour à tous

(...) je me suis mise au vba ya 2 mois et je dois produire une programme d'analyse énergétique autant te dire que c pas simple (...)

Nous avons tous connu cela, matis3854. Voici une proposition, aprés une refonte complète de votre classeur.
Je ne sais si c'est ce que vous recherchez, mais il ne s'agit que d'une ébauche et des adaptations sont évidemment possibles.​

Bon courage !
ROGER2327

 

[matis3854]

Re : fonction vba d'encadrement

Bonjour à tous

Nous avons tous connu cela, matis3854. Voici une proposition, aprés une refonte complète de votre classeur.
Je ne sais si c'est ce que vous recherchez, mais il ne s'agit que d'une ébauche et des adaptations sont évidemment possibles.​

Bon courage !
ROGER2327

Merci bcp, c'est dans l'idée que je cherche, maintenant il faut ke je l'adapte à mon programme, ce qui ne va pas etre évident!! ms je vais bosser dure pr essayer de comprendre ton bout de prg!!

 

[matis3854]

Re : fonction vba d'encadrement

Roger 2327,

je veux bien que tu m'expliques un peu quelques détails de la fonction que tu as créé si tu as le tps. Je pourrais très bien l'appliquer telle quelle mais j'aimerais comprendre pour progresser!!

Donc je copie la fonction en commentant mes pb :

Option Explicit ' je connais ça!! ça sert à quoi en début de prg?

Function fonction2(p1 As Range, p2 As Byte)
Dim oVal, i As Long
fonction2 = ""
If Not IsEmpty(p1) Then
With Sheets("DATA")
oVal = .Range(.Cells(2, 2 * p2 - 1).End(xlDown), .Cells(2, 2 * p2)).Value 'là je comprends pas la formule !! (xlDown??)
End With
For i = 1 To UBound(oVal, 1)
If p1.Value < oVal(i, 1) Then Exit For
Next i
If i <= UBound(oVal, 1) Then fonction2 = oVal(i, 2)
End If
End Function

 

[mromain]

Re : fonction vba d'encadrement

re,

le "Option Explicit" signifie que tu est obligé de déclarer les variables (Dim i as Integer, par exemple).
le "End(xlDown)" équivaut à faire un "{Ctrl} + {flèche du bas}" sur Excel.

en espérant t'avoir aidé ???

a+

 

[matis3854]

Re : fonction vba d'encadrement

re,

le "Option Explicit" signifie que tu est obligé de déclarer les variables (Dim i as Integer, par exemple).
le "End(xlDown)" équivaut à faire un "{Ctrl} + {flèche du bas}" sur Excel.

en espérant t'avoir aidé ???

a+

oui merci bcp. mais encore une question:

Comment faire si je veux appliquer une fonction à tous un ensemble de cellule et placer la réponse dans un autre ensemble de cellule : en gros :

range("a1:c4").value=fonction(range("a6:c9")) mais ca marche pas!!
Ou sinon je met ma formule dans les cellules concernées et je la tire , ca ca marche mais il faut actualiser la fonction car cette dernière est paramétrée par rapport à des valeurs de cellules qui changent!! dc est ce possible d'actualiser une formule?


Je peux te poser une question?? vous etes payé par microsoft excel pour aider les gens sur le site ou c'est du bénévolat!! ici ya tjs quelqu'un qui te répond en plus c rapide... Vous nous "vendez du rêve" en somme!!

 

[mromain]

Re : fonction vba d'encadrement

re,

à tester (avec une boucle) :

For i = 1 To 3
    For j = 1 To 4
        Cells(j, i).Value = fonction(Cells(j + 5, i))
    Next j
Next i

a+

ps: c'est pas mal comme slogan ça, "vendeur de rêve"

 

[ROGER2327]

Re : fonction vba d'encadrement

À matis3854 et aux autres que ça intéresserait,

Voici le code commenté :

Option Explicit [COLOR="Green"]'Toutes les variables devront être déclarée dans un instruction 'Dim'[/COLOR]

Function fonction2(p1 As Range, p2 As Byte) [COLOR="Green"]' La fonction prend deux arguments : la cellule où
' figure la donnée (p1) et un nombre entier (<256) indiquant quel "barème" on veut utiliser.[/COLOR]
Dim oVal, i As Long [COLOR="Green"]' Déclaration (obligatoire, voir ci-dessus) des données.[/COLOR]
    fonction2 = "" [COLOR="Green"]' Valeur retournée par défaut par la fonction.[/COLOR]
    If Not IsEmpty(p1) Then
    [COLOR="Green"]' Code exécuté si la cellule où figure la donnée n'est pas vide.
    ' Les trois lignes suivantes placeront les paramètres requis dans le tableau 'oVal'.
    ' - Si le barème demandé est 1 (valeur de 'p2'), il faut prendre les données des colonnes 1 & 2 (A & B).
    ' - Si le barème demandé est 2 (valeur de 'p2'), il faut prendre les données des colonnes 3 & 4 (C & D).
    ' - ...
    ' - Si le barème demandé est 'p2', il faut prendre les données des colonnes 2 * p2 - 1 & 2 * p2.
    ' Il est inutile de prendre toutes les lignes des deux colonnes requises.
    ' On a besoin des valeurs dans la plage dont les "coins" inférieur gauche et supérieur droit sont :
    '   'Sheets("DATA").Cells(2, 2 * p2 - 1).End(xlDown)'
    ' qui désigne la dernière cellule non vide de la colonne 2 * p2 - 1 à partir de la deuxième ligne.
    '   'Sheets("DATA").Cells(2, 2 * p2)'
    ' qui désigne la cellule de la deuxième ligne de la colonne 2 * p2.
    ' Ces valeurs sont placées dans le tableau 'oVal'.[/COLOR]
        With Sheets("DATA")
            oVal = .Range(.Cells(2, 2 * p2 - 1).End(xlDown), .Cells(2, 2 * p2)).Value
        End With
        [COLOR="Green"]' Les trois lignes suivantes servent à trouver dans quelle ligne du tableau 'oVal' sont
        ' les paramètres dont on a besoin. La boucle est exécutée jusqu'à ce que la valeur contenue
        ' dans la cellule 'p1' soit inférieure à la valeur contenue dans la ligne i et la première
        ' colonne du tableau. Dans ce cas on sort de la boucle (instruction 'Exit For').
        ' Si la valeur contenue dans la cellule 'p1' est supérieure à toutes les valeurs contenues dans
        ' la première colonne du tableau 'oVal', la boucle s'exécute tant que i n'est pas supérieur
        ' au nombre de lignes du tableau 'oVal' (ce nombre est 'UBound(oVal, 1)').[/COLOR]
        For i = 1 To UBound(oVal, 1)
            If p1.Value < oVal(i, 1) Then Exit For
        Next i
       [COLOR="Green"] ' Si i est inférieur ou égal à la nombre de lignes du tableau 'oVal', la fonction renvoie
        ' la valeur contenue dans la ligne i et dans la deuxième colonne du tableau 'oVal' :[/COLOR]
        If i <= UBound(oVal, 1) Then fonction2 = oVal(i, 2)
    End If
End Function

C'est un peu long à faire, mais si c'est nécessaire...​

ROGER2327

 

[matis3854]

Re : fonction vba d'encadrement

Merci beaucoup Roger2327

Ton bout de programme marche nickel, je l'ai adapté à mon problème et c'est tip top!!

En tout cas merci du temps que tu m'as accordé.

Bonne journée

 

[matis3854]

Re : fonction vba d'encadrement

re,

à tester (avec une boucle) :

For i = 1 To 3
    For j = 1 To 4
        Cells(j, i).Value = fonction(Cells(j + 5, i))
    Next j
Next i

a+

ps: c'est pas mal comme slogan ça, "vendeur de rêve"

Ouai je crois que c'est le mots qui convient, sans vous mon stage n'avancerait pas bcp!!! lol

Je vais tester la boucle!!

Merci bcp pour tout

 

[hobine]

Re : fonction vba d'encadrement

bonjour ,
je suis nouveau dans le blog et aussi dans la famille des programmeurs en vba. il y a une semaine j'ai commencé à programmer. là, je fais face à une difficulte, lorsque je compile , mon programme me dit qu'il y a une erreur au niveau de Tableau(i, 1) = Str(Tableau(i, 1)), executif "9", je vous envoies tout le programme afin que vous puissiez corriger l'erreur. Merci d'avance pour votre reponse



Sub listeDoublonsPlage()
Dim Plage As Range
Dim Tableau(), Resultat() As String
Dim Tableau_sans_zero() As String
Dim Tableau_cinq_jours() As Double
Dim Tableau_moy_lis() As Double
Dim i As Integer, j As Integer, m As Integer


Set Un = New Collection
'La plage de cellules (sur une colonne) à tester
Set Plage = Range("B10:B" & Range("B65536").End(xlUp).Row)

'lecture de la colonne B et affecter les valeurs dans Array
Tableau = Plage.Value

' il transforme les valeurs en string
For i = 1 To Plage.Count
Tableau(i, 1) = Str(Tableau(i, 1))
Next i

' il compte le nombre des elements vides

ncount = 0
For i = 1 To Plage.Count
If Tableau(i, 1) = " 0" Then
ncount = ncount + 1
End If
Next i
'ndim2 est la dim de la nouvelle array sans les elts vides
ndim2 = Plage.Count - ncount
' il definit la nouvelle dim
ReDim Tableau_sans_zero(ndim2)

' il met toutes les valeurs non nulles de l 'ancien tableau dans le nouveau tableau
ndim_count = 0
For i = 1 To Plage.Count
If Tableau(i, 1) <> " 0" Then
ndim_count = ndim_count + 1
Tableau_sans_zero(ndim_count) = Tableau(i, 1)
End If
Next i



'MsgBox ndim2
'MsgBox Tableau_sans_zero(0)
'MsgBox Tableau_sans_zero(ndim2 - 1)

som_dim = 0
' verification k le dernier elt est bien la somme des autres
For i = 1 To (ndim2 - 1)
som_dim = som_dim + Tableau_sans_zero(i)
Next i

If (som_dim - Tableau_sans_zero(ndim2) = 0) Then
ndim2 = ndim2 - 1
End If

' MsgBox ndim2

' ndim2 est le nombre de semaines travaillées

' moyenne de la production par semaine
moy = 0
For i = 1 To ndim2
moy = moy + Tableau_sans_zero(i)

Next i
moy = moy / ndim2
' MsgBox moy

' compter les semaines en moyenne 5 jrs travaillés
ndim3 = 0
For i = 1 To ndim2
tmp = Tableau_sans_zero(i) - (moy / 2)
If (tmp > 0) Then
ndim3 = ndim3 + 1
End If
Next i

ReDim Tableau_cinq_jours(ndim3)

MsgBox moy / 2
MsgBox ndim3

'remplir le tableau avec les elts sup moy/2
ndim_count = 0
For i = 1 To ndim2
tmp = Tableau_sans_zero(i) - (moy / 2)
If tmp > 0 Then
ndim_count = ndim_count + 1
Tableau_cinq_jours(ndim_count) = Tableau_sans_zero(i)


End If
Next i



ReDim Tableau_moy_lis(ndim3 - 2)

' calcul de toutes les moyennes lissées
For i = 3 To ndim3
Tableau_moy_lis(i - 2) = (1 / 3) * (Tableau_cinq_jours(i) + Tableau_cinq_jours(i - 1) + Tableau_cinq_jours(i - 2))
Next i

' MsgBox Tableau_moy_lis(1)
' MsgBox Tableau_moy_lis(ndim3 - 2)

' calcul de la somme du tableau 5 jours travaillés
OcQuad = 0
For i = 1 To ndim3
OcQuad = OcQuad + Tableau_cinq_jours(i)
Next i

' MsgBox OcQuad
' calcul du max 3SL

maxLS = 0
For i = 1 To (ndim3 - 2)
If Tableau_moy_lis(i) > maxLS Then
maxLS = Tableau_moy_lis(i)
End If
Next i
MsgBox maxLS
' sortir le max de 3SL et OcQuad pour afficher dans une fenetre

Cells(64, 8) = maxLS
'Worksheets("Feuil2" ).Cells(7, i + 1) = 2 + i
'Worksheets("TCD PMMECA").Cells(64, 8) = maxLS
'MsgBox Plage.Count

End Sub