Funcion Promedio ponderado
Juanjo
Después de buscar mucho en la web, pude hallar un código para definir
la función Promedio Ponderado, que en formula de excel sería
(sumaproducto(A1:A10; B1:B10)/suma(A1:A10)).
El problema es que cuando lo ejecuto (me pide la seleccion de los dos
rangos), me da como resultado #¡VALOR! , pero no me acusa ningún error
en la macro. Estimo que dee ser un problema de funciones en inglés/
español dentro de la macro. (yo uso Excel 2003 español).
Si alguien puede hacerlo funcionar, se lo agradecería mucho.
El ejemplo en numeros podría ser una mezla de ingredientes de ditintsa
humedad, cuanto sería la humedad resultante de la mezcla completa:
Kgs Humedad
1 12
2 22
3 31
KgsTot Hdad Ponderada
6 24,83
Acá va el código:
Public Function WeightedMedianOfRst(RstName As String, fldName As
String) As Double
'This function will calculate the weighted median of a recordset.
The field must be a number value.
Dim MedianTemp As Double
Dim ThisValue As Double
Dim NumRecs As Long
Dim RstOrig As Recordset
Set RstOrig = CurrentDb.OpenRecordset(RstName, dbOpenDynaset)
RstOrig.Sort = fldName
Dim RstSorted As Recordset
Dim RstFiltered As Recordset
Set RstSorted = RstOrig.OpenRecordset()
If RstSorted.RecordCount Mod 2 = 0 Then
RstSorted.AbsolutePosition = (RstSorted.RecordCount / 2) - 1
ThisValue = RstSorted.Fields(fldName).Value
RstOrig.Filter = "[" & fldName & "] = " & ThisValue
Set RstFiltered = RstOrig.OpenRecordset()
MedianTemp = ThisValue * RstFiltered.RecordCount
NumRecs = RstFiltered.RecordCount
RstSorted.MoveNext
ThisValue = RstSorted.Fields(fldName).Value
RstOrig.Filter = "[" & fldName & "] = " & ThisValue
Set RstFiltered = RstOrig.OpenRecordset()
NumRecs = NumRecs + RstFiltered.RecordCount
MedianTemp = MedianTemp + ThisValue *
RstFiltered.RecordCount
MedianTemp = MedianTemp / NumRecs
Else
RstSorted.AbsolutePosition = (RstSorted.RecordCount - 1) / 2
MedianTemp = RstSorted.Fields(fldName).Value
End If
WeightedMedianOfRst = MedianTemp
End Function
Private Sub test()
MsgBox MedianOfRst("Orders", "Freight")
End Sub
Saludos a todos y FELICES PASCUAS
Juanjo