Discussione:
Excel VBA - Media di valori presi a caso
(troppo vecchio per rispondere)
Marco Porzio
2018-03-06 09:58:01 UTC
Permalink
Ciao,
ho la necessità di calcolare la media di 50 valori presi a caso all'interno di una colonna con 80 valori.
con il codice di seguito sono riuscito a fare tutto, l'unica cosa è che utilizza un foglio di "appoggio" per eseguire l'operazione.
Vorrei modificare la parte finale del codice al fine di fare tutto senza il foglio di appoggio se possibile.
Questa la riga di codice che mi da problemi:

Last_Row2 = Foglio2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Questo il codice completo (Vorrei fare tutto in Foglio3):

Public Sub ElaboraDati()

Dim arr As New Collection
Dim i As Long
Dim IndiceCasuale As String


Dim DA_ESTRARRE As Integer
Dim Estratti As Integer

DA_ESTRARRE = Foglio3.Range("S1")


'-------------------------------------------------------------------------

Foglio2.Select
Foglio2.Range("A1:A150").Select
Foglio2.Range("A1:A150").ClearContents
Foglio3.Select

'-------------------------------------------------------------------------


'Individuo ultima riga non vuota dell'elenco
'Foglio3.Range("B9:B88").Select
Max = Foglio3.Cells.Find("B88", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Definisco intervallo inferiore (indice della prima riga contente i dati)
Min = 9 'é la riga del primo elemento dell'elenco


'Ripeto il ciclo DO-LOOP fino a quando il numero di elementi contenuti nel vettore 'arr'
'è uguale al numero degli elementi da estrarre 'DA_ESTRARRE
Do Until arr.Count = DA_ESTRARRE

'estraggo un numero da inserire in un vettore
IndiceCasuale = Int((Max - Min + 1) * Rnd + Min)


'Se il numero fosse già presente nel vettore, non sarebbe possibile inserirlo e si genererebbe un errore.
'Ottengo quindi il risultato voluto (estrazione senza ripetizione)
'e faccio riprendere il ciclo
On Error Resume Next
arr.Add IndiceCasuale, IndiceCasuale

Loop


For i = 1 To arr.Count

'Ricalcolo l'ultima riga vuota del foglio in cui estrarre i dati
Last_Row2 = Foglio2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Last_Row2 = Foglio3.Cells.Find("T50", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Copio nel foglio ESTRAZIONE i valori del foglio DATI
'utilizzando i numeri di riga casuali estratti precedentemente ed inseriti nel vettore arr
'di cui prendo gli gli elementi 'i' dal numero 1 all'ultimo arr.Count
Foglio2.Cells(Last_Row2 + 1, 1) = Foglio3.Cells(arr(i), 2)

Next


End Sub
Bruno Campanini
2018-03-07 01:35:52 UTC
Permalink
Post by Marco Porzio
Ciao,
ho la necessità di calcolare la media di 50 valori presi a caso all'interno
di una colonna con 80 valori. con il codice di seguito sono riuscito a fare
tutto, l'unica cosa è che utilizza un foglio di "appoggio" per eseguire
l'operazione. Vorrei modificare la parte finale del codice al fine di fare
tutto senza il foglio di appoggio se possibile. Questa la riga di codice che
Last_Row2 = Foglio2.Cells.Find("*", SearchOrder:=xlByRows,
SearchDirection:=xlPrevious).Row
Prova questa:
=======================================
Public Sub MediaRandom()
Dim StartCell As Range, Coll As New Collection, R As Long
Dim i As Long, j As Long, k As Long, n As Long, S

Set StartCell = [Sheet5!B1] ' prima cella dati
j = 10 ' elementi della media

Set StartCell = Range(StartCell, StartCell.End(xlDown))
n = StartCell.count ' numero dati definito da programma
For i = 1 To n
R = Int(n * Rnd + 1)
On Error GoTo Err
S = CDec(S + StartCell(R)): k = k + 1
If Coll.count = j Then Exit For
Continua:
Next
MsgBox S / k
Exit Sub
Err:
On Error GoTo 0
Resume Continua
End Sub
=================================

Bruno
Marco Porzio
2018-03-07 09:05:43 UTC
Permalink
Post by Bruno Campanini
Post by Marco Porzio
Ciao,
ho la necessità di calcolare la media di 50 valori presi a caso all'interno
di una colonna con 80 valori. con il codice di seguito sono riuscito a fare
tutto, l'unica cosa è che utilizza un foglio di "appoggio" per eseguire
l'operazione. Vorrei modificare la parte finale del codice al fine di fare
tutto senza il foglio di appoggio se possibile. Questa la riga di codice che
Last_Row2 = Foglio2.Cells.Find("*", SearchOrder:=xlByRows,
SearchDirection:=xlPrevious).Row
=======================================
Public Sub MediaRandom()
Dim StartCell As Range, Coll As New Collection, R As Long
Dim i As Long, j As Long, k As Long, n As Long, S
Set StartCell = [Sheet5!B1] ' prima cella dati
j = 10 ' elementi della media
Set StartCell = Range(StartCell, StartCell.End(xlDown))
n = StartCell.count ' numero dati definito da programma
For i = 1 To n
R = Int(n * Rnd + 1)
On Error GoTo Err
S = CDec(S + StartCell(R)): k = k + 1
If Coll.count = j Then Exit For
Next
MsgBox S / k
Exit Sub
On Error GoTo 0
Resume Continua
End Sub
=================================
Bruno
Ciao,
funziona perfettamente!!
è possibile calcolare anche la Deviazione standard di questi stessi valori?
grazie
Bruno Campanini
2018-03-07 13:58:33 UTC
Permalink
Post by Marco Porzio
Ciao,
funziona perfettamente!!
Avevo lasciato in giro qualcosa che non c'entrava...
Post by Marco Porzio
è possibile calcolare anche la Deviazione standard di questi stessi valori?
grazie
Qualche precisazione:
1) La media su un campione nel quale sono eliminati i doppioni
non so proprio che valore possa avere, quindi la procedura
non li elimina.

2) La varianza e lo scarto quadratico medio possono essere
calcolati nella forma normale (al denominatore la dimensione
del campione) ovvero in quella corretta (al denominatore
la dimensione del campione - 1).

=============================================
Public Sub MediaRandom_StdDev()
Dim StartCell As Range, R As Long, S, Sc2, M1
Dim i As Long, j As Long, k As Long, n As Long

Set StartCell = [Sheet5!B1] ' prima cella dati
j = 100 ' dimensione del Campione

Set StartCell = Range(StartCell, StartCell.End(xlDown))
n = StartCell.count ' dimension dell'Universo
ReDim S2(1 To j)

For i = 1 To n
R = Int(n * Rnd + 1)
k = k + 1
S2(k) = StartCell(R)
S = CDec(S + S2(k))
If k = j Then Exit For
Next
M1 = CDec(S / j) ' media campionaria
For i = 1 To j
Sc2 = CDec(Sc2 + (S2(i) - M1) ^ 2)
Next

MsgBox "Universo = " & n & vbCrLf & "Campione = " & j & vbCrLf & _
vbLf & "M1 = " & M1 & vbCrLf & "StdDev = " & Sqr(Sc2 / j) & _
vbCrLf & "StdDev Corretta = " & Sqr(Sc2 / (j - 1))

End Sub
===================================

Bruno
Marco Porzio
2018-03-07 14:14:36 UTC
Permalink
Post by Bruno Campanini
Post by Marco Porzio
Ciao,
funziona perfettamente!!
Avevo lasciato in giro qualcosa che non c'entrava...
Post by Marco Porzio
è possibile calcolare anche la Deviazione standard di questi stessi valori?
grazie
1) La media su un campione nel quale sono eliminati i doppioni
non so proprio che valore possa avere, quindi la procedura
non li elimina.
2) La varianza e lo scarto quadratico medio possono essere
calcolati nella forma normale (al denominatore la dimensione
del campione) ovvero in quella corretta (al denominatore
la dimensione del campione - 1).
=============================================
Public Sub MediaRandom_StdDev()
Dim StartCell As Range, R As Long, S, Sc2, M1
Dim i As Long, j As Long, k As Long, n As Long
Set StartCell = [Sheet5!B1] ' prima cella dati
j = 100 ' dimensione del Campione
Set StartCell = Range(StartCell, StartCell.End(xlDown))
n = StartCell.count ' dimension dell'Universo
ReDim S2(1 To j)
For i = 1 To n
R = Int(n * Rnd + 1)
k = k + 1
S2(k) = StartCell(R)
S = CDec(S + S2(k))
If k = j Then Exit For
Next
M1 = CDec(S / j) ' media campionaria
For i = 1 To j
Sc2 = CDec(Sc2 + (S2(i) - M1) ^ 2)
Next
MsgBox "Universo = " & n & vbCrLf & "Campione = " & j & vbCrLf & _
vbLf & "M1 = " & M1 & vbCrLf & "StdDev = " & Sqr(Sc2 / j) & _
vbCrLf & "StdDev Corretta = " & Sqr(Sc2 / (j - 1))
End Sub
===================================
Bruno
Ciao,
cosa intendi per "Doppioni eliminati"?
il codice che hai postato, calcola la Dev.St. degli stessi valori usati per fare la media?

in pratica, di 80 campioni (80 celle popolate in colonna B) devo prenderne 50 a caso e fare media e deviazione standard (sempre degli stessi 50)

si potrebbe magari andare a mettere i 50 dati presi a caso in una colonna (es.: AA) poi io nella cella AA51 e AA52 eseguo media e deviazione che dici?
Marco
Bruno Campanini
2018-03-07 19:24:35 UTC
Permalink
Post by Marco Porzio
Ciao,
cosa intendi per "Doppioni eliminati"?
Intendo che su 2A, 3B, 5C oggetti, quelli eliminati sono 1A, 2B, 4C.
Post by Marco Porzio
il codice che hai postato, calcola la Dev.St. degli stessi valori usati per fare la media?
Certo!
Post by Marco Porzio
in pratica, di 80 campioni (80 celle popolate in colonna B) devo prenderne 50
a caso e fare media e deviazione standard (sempre degli stessi 50)
Ed è ciò che avviene.
Post by Marco Porzio
si potrebbe magari andare a mettere i 50 dati presi a caso in una colonna
(es.: AA) poi io nella cella AA51 e AA52 eseguo media e deviazione che dici?
Che si può fare.

Bruno
Marco Porzio
2018-03-07 19:38:56 UTC
Permalink
Allora scusami ma non ho capito il post precedente... se il codice calcola la dev st degli stessi 50 dati allora mi basta unire il codice di media e dev st e popolare 2 celle con i relativi valori usando un solo pulsante.
In ogni caso, come faccio nel tuo codice a popolare 50 celle con i 50 dati random estratti?
Grazie
Marco
Bruno Campanini
2018-03-08 10:41:48 UTC
Permalink
Post by Marco Porzio
Allora scusami ma non ho capito il post precedente... se il codice calcola la
dev st degli stessi 50 dati allora mi basta unire il codice di media e dev st
e popolare 2 celle con i relativi valori usando un solo pulsante. In ogni
caso, come faccio nel tuo codice a popolare 50 celle con i 50 dati random
estratti? Grazie Marco
Fa' così:
===================================
Public Sub MediaRandom_StdDev()
'
' Excel 2016 BC.xlsm Module: BC 11-03-2018
'
' Con riferimento ai valori in StartCell.End(xlDown) estrae Random un
' campione di j elementi e di questi determina la media aritmentica,
' la Standard Deviation (scarto quadratico medio) e la
' Standard Deviation corretta, cui corrispondono le WorksheetFormula:
' AVERAGE(range), STDEV.P(range), STDEV.S(range)
'
Dim StartCell As Range, R As Long, S, Sc2, M1
Dim i As Long, j As Long, k As Long, n As Long
Dim TargetRange As Range

Set StartCell = [Sheet5!B1] ' prima cella dati
j = 100 ' dimensione campione
Set TargetRange = [Sheet5!C1] ' dove stampare i valori estratti

Set StartCell = Range(StartCell, StartCell.End(xlDown))
n = StartCell.count ' Universo
ReDim S2(1 To j)

For i = 1 To n
R = Int(n * Rnd + 1)
k = k + 1
S2(k) = StartCell(R)
TargetRange(k + 4) = S2(k)
S = CDec(S + S2(k))
If k = j Then Exit For
Next
M1 = CDec(S / j) ' Media campionaria

' Stampa le WorksheetFormula per M1, StdDev, StdDev Corretta
TargetRange(1).Formula = "=Average(" & TargetRange(5).Address & ":" &
TargetRange(j + 4).Address & ")"
TargetRange(2).Formula = "=Stdev.P(" & TargetRange(5).Address & ":" &
TargetRange(j + 4).Address & ")"
TargetRange(3).Formula = "=Stdev.S(" & TargetRange(5).Address & ":" &
TargetRange(j + 4).Address & ")"

For i = 1 To j
Sc2 = CDec(Sc2 + (S2(i) - M1) ^ 2)
Next

MsgBox "Universo = " & n & vbCrLf & "Campione = " & j & vbCrLf & _
vbLf & "M1 = " & M1 & vbCrLf & "StdDev = " & Sqr(Sc2 / j) & _
vbCrLf & "StdDev Corretta = " & Sqr(Sc2 / (j - 1))

End Sub
==================================



Ti allego anche la routine che determina una colonna
di numeri random per verificare i risultati... caso mai
volessi fare ulteriori esperimenti:
==================================================
Public Sub MediaRandom_StdDev_Sample()
Dim TargetRange As Range, R As Long
Dim i As Long, j As Long, k As Long, n As Long, S, Sc2, M1

Set TargetRange = [Sheet5!B1] ' prima cella dati
n = 1000 ' numero dati

For i = 1 To n
R = Int(n * Rnd + 1)
k = k + 1
TargetRange(k) = R
Next

End Sub
==================================================

Bruno
Marco Porzio
2018-03-08 12:55:09 UTC
Permalink
Post by Bruno Campanini
Post by Marco Porzio
Allora scusami ma non ho capito il post precedente... se il codice calcola la
dev st degli stessi 50 dati allora mi basta unire il codice di media e dev st
e popolare 2 celle con i relativi valori usando un solo pulsante. In ogni
caso, come faccio nel tuo codice a popolare 50 celle con i 50 dati random
estratti? Grazie Marco
===================================
Public Sub MediaRandom_StdDev()
'
' Excel 2016 BC.xlsm Module: BC 11-03-2018
'
' Con riferimento ai valori in StartCell.End(xlDown) estrae Random un
' campione di j elementi e di questi determina la media aritmentica,
' la Standard Deviation (scarto quadratico medio) e la
' AVERAGE(range), STDEV.P(range), STDEV.S(range)
'
Dim StartCell As Range, R As Long, S, Sc2, M1
Dim i As Long, j As Long, k As Long, n As Long
Dim TargetRange As Range
Set StartCell = [Sheet5!B1] ' prima cella dati
j = 100 ' dimensione campione
Set TargetRange = [Sheet5!C1] ' dove stampare i valori estratti
Set StartCell = Range(StartCell, StartCell.End(xlDown))
n = StartCell.count ' Universo
ReDim S2(1 To j)
For i = 1 To n
R = Int(n * Rnd + 1)
k = k + 1
S2(k) = StartCell(R)
TargetRange(k + 4) = S2(k)
S = CDec(S + S2(k))
If k = j Then Exit For
Next
M1 = CDec(S / j) ' Media campionaria
' Stampa le WorksheetFormula per M1, StdDev, StdDev Corretta
TargetRange(1).Formula = "=Average(" & TargetRange(5).Address & ":" &
TargetRange(j + 4).Address & ")"
TargetRange(2).Formula = "=Stdev.P(" & TargetRange(5).Address & ":" &
TargetRange(j + 4).Address & ")"
TargetRange(3).Formula = "=Stdev.S(" & TargetRange(5).Address & ":" &
TargetRange(j + 4).Address & ")"
For i = 1 To j
Sc2 = CDec(Sc2 + (S2(i) - M1) ^ 2)
Next
MsgBox "Universo = " & n & vbCrLf & "Campione = " & j & vbCrLf & _
vbLf & "M1 = " & M1 & vbCrLf & "StdDev = " & Sqr(Sc2 / j) & _
vbCrLf & "StdDev Corretta = " & Sqr(Sc2 / (j - 1))
End Sub
==================================
Ti allego anche la routine che determina una colonna
di numeri random per verificare i risultati... caso mai
==================================================
Public Sub MediaRandom_StdDev_Sample()
Dim TargetRange As Range, R As Long
Dim i As Long, j As Long, k As Long, n As Long, S, Sc2, M1
Set TargetRange = [Sheet5!B1] ' prima cella dati
n = 1000 ' numero dati
For i = 1 To n
R = Int(n * Rnd + 1)
k = k + 1
TargetRange(k) = R
Next
End Sub
==================================================
Bruno
Ora sembra tutto perfetto, grazie 1000
Marco

Loading...