Ricerca pesi media ponderata

Hai un problema con Excel?

Nuova discussione

Ricerca pesi media ponderata
di Carletto (utente non iscritto) data: 12/02/2015 10:52:19
Ciao a tutti!
Vorrei sapere se è possibile trovare i pesi da associare ad alcuni valori in modo tale da ottenere la media ponderata desiderata.
Ho cercato nelle discussioni passate le keywords "media", "pesi", "ricerca", "obiettivo" e altre simili ma non ho trovato niente che faccia al caso mio.
Il ragionamento credo sia simile ad una ricerca obiettivo ripetuta, ma non saprei dove iniziare..potete aiutarmi?
Allego il file di esempio con la descrizione dettagliata di ciò di cui avrei bisogno.
Grazie ancora una volta a questo fantastico forum.
di Vecchio Frac data: 12/02/2015 11:41:51
Mi definisci la "media ponderata" ?
Tale media è calcolata su tutti i valori presenti?
Altrimenti, preso il primo valore (100) e gli obiettivi (91 e 92), che peso ti aspetteresti?
di Carletto (utente non iscritto) data: 12/02/2015 11:51:55
Ciao Vecchio Frac!
Eh sì, la media è calcolata su tutti i valori presenti con la formula classica (sommatoria dei prodotti tra valori e pesi).
Al momento non saprei che peso aspettarmi per i diversi valori, questo è un problema secondo te?
Cioè, se trovassi dei pesi "di partenza" - ma non corretti - potrebbe essere utile o il problema si riesce a risolvere comunque?
Grazie!
di Vecchio Frac data: 12/02/2015 13:11:42
Mi sono documentato sulla media ponderata (metodo lungo e metodo breve con SUMPRODUCT). Già in effetti non so se è un vero problema ricavare la seconda colonna senza conoscere neanche la media ponderata. Probabilmente bisogna testare empiricamente, come dici tu, con dei pesi di partenza per cercare di avvicinarsi al risultato.
di Carletto (utente non iscritto) data: 12/02/2015 13:46:47
Inserisco un nuovo allegato (esempio2) in cui ho messo dei pesi "finti" ma più o meno corrispondenti a quelli effettivi.
Chiedo che l'obiettivo sia una media ponderata (calcolata nella cella evidenziata in verde con la formula già impostata) uguale al valore della cella B16.
Avendo questi dati, secondo te si può fare qualcosa? Io non saprei costruire una macro per questi tentativi...
Grazie
di Vecchio Frac data: 12/02/2015 14:01:45
Vedi, il problema (mio) non è tanto scrivere due righe di codice per riempire un range di valori dei quali calcolare la media ponderata, quanto piuttosto capire se i "pesi" vengono pescati a caso fino a raggiungere l'obiettivo, o se c'è una logica (come credo verosimile) nella loro scelta.
Per il tuo "esempio 2": perchè "var 1" che vale 100 viene pesato al 30% e "var 7" che vale 62 viene pesato al 26%? hai adottato un criterio? hai ridotto (o aumentato i pesi) di un certo quantitativo a caso?

di Vecchio Frac data: 12/02/2015 14:05:27
Per dirti, questo è quello che farei io (mi baso sul primo esempio, quello che cerca un obiettivo tra due obiettivi inseriti).

Option Explicit

Sub Pulsante1_Click()
Dim rng As Range, max_value As Long, cell As Range
Dim d As Single

    Set rng = Range("B2:B14")
    
    max_value = Application.Max(rng)
    
    For Each cell In rng
    
        d = cell / max_value
        
        cell.Offset(, 1) = d
        
    Next
    
    Randomize Timer
    
    Do
    
        For Each cell In rng.Offset(, 1)
        
            cell = Rnd(1) * 1
            
        Next
        
    Loop Until Range("C16") - Range("B15") < 1# And Range("B16") - Range("C16") < 1#
      
    MsgBox "Finito"
    
End Sub

di Vecchio Frac data: 12/02/2015 14:08:09
Nota prima che mi dimentichi.
Il primo "for each cell in rng" è del tutto superfluo se inseriamo valori random, l'ho lasciato in questo test (serve a per rapportare ogni valore al valore massimo inserito, in modo da ridurlo o aumentarlo se decidiamo che c'è un criterio da adottare).
di Luca73 data: 12/02/2015 14:18:59
Ciao a tutti
da come descritto il problema ha infinite soluzione se non si definisce un criterio per definire i pesi.
la soluzione più semplice sarebbe mettere un peso uguale a tutti i valori pari al rapporto tra obiettivo e media reale.
se non avessi alcun vincolo io porrei peso uguale ad uno a tutti i valori inferiori al valore cercato, porrei il peso uguale a tutti i alori superiori alla media e poi con un cerca obiettivo cercherei il peso che mi fa tornare il risultato.
di Carletto (utente non iscritto) data: 12/02/2015 14:19:08
Capisco.
I pesi si rifanno ad alcuni dati storici, legati alle diverse variabili, ma slegati completamente dal valore che è inserito nella colonna B. Li ho messi solo per aver un'indicazione da cui partire, ma mi rendo conto che forse non sono molto utili, poiché i pesi che ho messo non sono legati al valore di B indicate nell'esempio, ma ad altri valori che nulla hanno a che vedere con il conteggio di B, pur essendo legati alle variabili 1, 2, 3 ecc....

Perciò, in questo caso si potrebbe dire che non esiste una vera logica e mi aspetto che i pesi possano anche cambiare completamente.
L'unica condizione che pongo è che siano tutti maggiori di 0 e che la loro somma sia 1.

So che quello che chiedo sembra strano, ma ho davvero necessità di capire se riesco ad arrivare alla soluzione richiesta nell'esempio: come escano poi i pesi non mi interessa. L'unica cosa che conta è arrivare ad una media uguale al valore obiettivo.
Ora che sei al corrente di questa informazione - e mi rendo conto benissimo che può sembrare pazzia, ma mi è davvero utile - credi di potermi aiutare?
Grazie ancora, e non giudicarmi troppo male per questa richiesta strampalata
di Carletto (utente non iscritto) data: 12/02/2015 14:20:53
Ci ho messo un po' a rispondere e ho visto ora le vostre risposte
Adesso provo a vedere come funzionano :)
Grazie!

di Vecchio Frac data: 12/02/2015 14:29:03
La proposta di Luca73 è sensata (nebulosamente nella mia testa cercavo una soluzione di questo genere).
Ma alla fine vedo che ti accontenti di valori casuali... allora il codice di prima, rimaneggiato e semplificato perchè tu possa inserire valori obiettivo 1 e 2 arbitrari (cioè la cui differenza sia diversa da uno), va rivisto nel modo che segue. E' veloce e dà un risultato verosimile.

Option Explicit

Sub Pulsante1_Click()
Dim cell As Range
    
    Randomize Timer
    Do
        For Each cell In Range("C2:C14")
            cell = Rnd(1) * 1
        Next
    Loop Until Range("C16") >= Range("B15") And Range("C16") <= Range("B16")
      
    MsgBox "Finito"
End Sub

di Carletto (utente non iscritto) data: 12/02/2015 14:34:14
Ciao Vecchio Frac, il tuo metodo per simulare i pesi funziona per arrivare al risultato,
ho solo aggiunto la condizione che il range contenente la somma dei range sia uguale a 1 e spero che trovi risultati
Grazie mille!
Grazie anche a te lepat, purtroppo non ho modo di definire un criterio univoco per questi pesi :(
Buona giornata a tutti e due!
di Carletto (utente non iscritto) data: 12/02/2015 14:37:18
Grazie per l'aggiornamento Vecchio Frac!
:)
di Vecchio Frac data: 12/02/2015 14:57:42
cit. "ho solo aggiunto la condizione che il range contenente la somma dei range sia uguale a 1 e spero che trovi risultati "
---> Temo che sarà molto dura perchè i valori estratti sono assolutamente casuali e raggiungere le condizioni (somma = 1 e range tra obiettivo 1 e obiettivo 2) non la vedo agevole.

di scossa data: 12/02/2015 16:41:54
Magari non ho capito la richiesta, però il codice sotto mi pare faccia quanto richiesto.

In sintesi la logica è più o meno la seguente:


- assegno a tutti i valori il peso di  1/numero_di_valori (nel nostro caso 1/13)
- individuo la cella col valore più basso
- individuo la cella col valore più alto
- finchè la formula (C16) non è uguale all'obiettivo (arrotondati a 3 decimali entrambi)
    se target è > obiettivo
      se entrambi i valori sono uno superiore a 0.0001 e l'altro inferiore a 0.9999
        decremento il valore più alto di 0.0001
        incremento il valore più basso di 0.0001
    altrimenti
      se entrambi i valori sono uno inferiore a 0.9999 e l'altro superiore a 0.0002
        incremento il valore più alto di 0.0001
        decremento il valore più basso di 0.0001
   altrimenti trovo il secondo valore più grande ed il secondo valore più piccolo   
 e ripeto il ciclo.

scossa's web site

Se tu hai una mela, ed io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno.
Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

Sub Pulsante1_Click()
  Dim ws As Worksheet
  Dim rngMin As Range
  Dim rngMax As Range
  Dim rngVal As Range
  Dim rngPesi As Range
  Dim rngTarget As Range
  Dim nPeso As Double
  Dim nOb As Double
  Dim j As Long
  Dim k As Long
  
  Set ws = ActiveSheet
  Set rngVal = ws.Range("B2:B14")
  Set rngPesi = ws.Range("C2:C14")
  Set rngTarget = ws.Range("C16")
  nOb = Round(ws.Range("B16").Value, 3)
  
  With Application.WorksheetFunction
    Set rngMin = rngVal.Cells(.Match(.Small(rngVal, 1), rngVal, 0), 1)
    Set rngMax = rngVal.Cells(.Match(.Large(rngVal, 1), rngVal, 0), 1)
    rngPesi.Value = Round(1 / rngPesi.Rows.Count, 6)
    nPeso = Round(.Sum(rngPesi), 5)
  End With
  j = 0
  Do While Round(rngTarget.Value, 2) <> nOb And j <= rngPesi.Rows.Count
    If Round(rngTarget.Value, 2) > nOb Then
      With rngMax.Offset(0, 1)
        If .Value > 0.0001 And rngMin.Offset(0, 1).Value < 0.9999 Then
          .Value = .Value - 0.0001
          rngMin.Offset(0, 1).Value = rngMin.Offset(0, 1).Value + 0.0001
        Else
          j = j + 1
          With Application.WorksheetFunction
            Set rngMin = rngVal.Cells(.Match(.Small(rngVal, j), rngVal, 0), 1)
            Set rngMax = rngVal.Cells(.Match(.Large(rngVal, j), rngVal, 0), 1)
          End With
        End If
      End With
    Else
      With rngMax.Offset(0, 1)
        If .Value < 0.9999 And rngMin.Offset(0, 1).Value > 0.0002 Then
          .Value = .Value + 0.0001
          rngMin.Offset(0, 1).Value = rngMin.Offset(0, 1).Value - 0.0001
        Else
          j = j + 1
          With Application.WorksheetFunction
            Set rngMin = rngVal.Cells(.Match(.Small(rngVal, j), rngVal, 0), 1)
            Set rngMax = rngVal.Cells(.Match(.Large(rngVal, j), rngVal, 0), 1)
          End With
        End If
      End With
    End If
  Loop
  
  If Round(rngTarget.Value, 2) = nOb Then MsgBox "Bingo!" Else MsgBox "Failed!"

  Set rngPesi = Nothing
  Set rngTarget = Nothing
  Set rngOb = Nothing

End Sub

di scossa data: 12/02/2015 16:44:28
errata-corrige:
decremento il valore più alto ....
incremento il valore più basso ....

leggasi
decremento il peso del valore più alto ....
incremento il peso del valore più basso ....

in tutte le relative righe

scossa's web site

di Vecchio Frac data: 12/02/2015 17:52:24
@Carletto
Questa di scossa è una soluzione già più robusta e logica perchè ha predeterminato dei criteri, e soprattutto con un esito finito, e penso che sia imprescindibile che trovi dei criteri equivalenti. Non fornisce un modello pseudo casuale come sembrava che gradissi ma è perchè attua un metodo rigoroso.
L'unica cosa su cui sono perplesso è l'uso di Round() perchè ho in mente un vago ricordo che questa funzione lavora in modo impreciso. In effetti =ARROTONDA(10,5;0) per Excel fa 11 mentre ?Round(10.5,0) per VBA fa 10.

di scossa data: 12/02/2015 23:07:49
cit. V.F.: "Non fornisce un modello pseudo casuale come sembrava che gradissi ....."

Nel codice sottoriportato ho aggiunto anche una pseudo casualità nei pesi.

cit. V.F.: "L'unica cosa su cui sono perplesso è l'uso di Round() ....."

L'arrotondamento ovviamente è necessario, si può aumentare la precisione a spese di un maggior tempo di esecuzione. Nel codice ho portato l'arrotondamento a 4 decimali dopo la virgola, con variazioni di 0.000001 in + ed in -.

scossa's web site

Sub Pulsante1_Click()
  Dim ws As Worksheet
  Dim rngMin As Range
  Dim rngMax As Range
  Dim rngVal As Range
  Dim rngPesi As Range
  Dim rngTarget As Range
  Dim nPeso As Double
  Dim nOb As Double
  Dim j As Long
  Dim nRows As Long
  Dim nRand As Single
  Dim nDummy
  
  Set ws = ActiveSheet
  Set rngVal = ws.Range("B2:B14")
  Set rngPesi = ws.Range("C2:C14")
  Set rngTarget = ws.Range("C16")
  nOb = Round(ws.Range("B16").Value, 4)
  nRows = rngPesi.Rows.Count
  
  With Application.WorksheetFunction
    Set rngMin = rngVal.Cells(.Match(.Small(rngVal, 1), rngVal, 0), 1)
    Set rngMax = rngVal.Cells(.Match(.Large(rngVal, 1), rngVal, 0), 1)
    rngPesi.Value = Round(1 / nRows, 6)
    nPeso = Round(.Sum(rngPesi), 5)
  End With
  
  For j = 1 To Int(nRows / 2)
    Randomize Timer
    nRand = Application.RandBetween(5, 10) / 100 + Rnd() / 1000
    nDummy = rngPesi.Offset(Int(nRows / 2), 0).Cells(1, 1).Value
    If Abs(nDummy + (rngPesi(j, 1).Value - nRand)) < 1 And Abs(nDummy + (rngPesi(j, 1).Value - nRand)) > 0 Then
      rngPesi.Offset(Int(nRows / 2) + j, 0).Cells(1, 1).Value = nDummy + (rngPesi(j, 1).Value - nRand)
      rngPesi(j, 1) = nRand
    End If
  Next
  j = 0
  Do While Round(rngTarget.Value, 4) <> nOb And j <= nRows
    If Round(rngTarget.Value, 2) > nOb Then
      With rngMax.Offset(0, 1)
        If .Value > 0.000001 And rngMin.Offset(0, 1).Value < 0.999999 Then
          .Value = .Value - 0.000001
          rngMin.Offset(0, 1).Value = rngMin.Offset(0, 1).Value + 0.000001
        Else
          j = j + 1
          With Application.WorksheetFunction
            Set rngMin = rngVal.Cells(.Match(.Small(rngVal, j), rngVal, 0), 1)
            Set rngMax = rngVal.Cells(.Match(.Large(rngVal, j), rngVal, 0), 1)
          End With
        End If
      End With
    Else
      With rngMax.Offset(0, 1)
        If .Value < 0.999999 And rngMin.Offset(0, 1).Value > 0.000001 Then
          .Value = .Value + 0.000001
          rngMin.Offset(0, 1).Value = rngMin.Offset(0, 1).Value - 0.000001
        Else
          j = j + 1
          With Application.WorksheetFunction
            Set rngMin = rngVal.Cells(.Match(.Small(rngVal, j), rngVal, 0), 1)
            Set rngMax = rngVal.Cells(.Match(.Large(rngVal, j), rngVal, 0), 1)
          End With
        End If
      End With
    End If
  Loop
  
  If Round(rngTarget.Value, 4) = nOb Then MsgBox "Bingo!" Else MsgBox "Failed!"

  Set rngPesi = Nothing
  Set rngTarget = Nothing
  Set rngOb = Nothing

End Sub

di scossa data: 13/02/2015 15:38:30
Comunque sarebbe interessante sapere da Carletto quali siano le "tolleranze" per considerare uguali i valori B16 e C16.

scossa's web site

di Vecchio Frac data: 13/02/2015 15:45:20
La tua soluzione era già interessante di suo, gli affinamenti dipendono anche dalla esigenza dell'interlocutore (che sta ancora digerendo la prima proposta ^_^).
Su Round la mia perplessità non è nel suo uso in questo codice, ma nella validità di questa funzione che sembra avere un comportamento inatteso in alcune situazioni.

cit. "sarebbe interessante sapere da Carletto quali siano le "tolleranze"
---> in uno dei miei primi test avevo impostato questa tolleranza inferiore a uno.

di scossa data: 13/02/2015 16:09:06
cit. VF: ".... nella validità di Round() che sembra avere un comportamento inatteso in alcune situazioni"

Il comportamento di VBA.Round() che hai notato (e che vale solo se la parte decimale del primo argomento è .5 ed il secondo argomento è 0 od omesso) in realtà non è "inatteso" ma "bizzarro": se la parte intera è pari arrotonda per difetto, se la parte intera è dispari arrotonda per eccesso (in pratica restituisce sempre un valore pari):

?vba.Round(0.50,0)
0
?vba.Round(1.50,0)
2
?vba.Round(2.50,0)
2
?vba.Round(3.50,0)
4
?vba.Round(4.50,0)
4
?vba.Round(5.50,0)
6

etc. etc.
Saperlo permette di prendere, se necessario, eventuali contromisure: ad esempio sommare 10^-9 al valore da arrotondare !?

scossa's web site

Vuoi Approfondire?