numeri casuali parteno da un valore medio

Question

Buongiorno a tutti,

vorrei sapere se è possibile creare un elenco di numeri casuali partendo da un valore medio.

Mi spiego meglio, ho un'infinità di dati scaricati da un database access ove ho la lettura dell'altezza dell'acqua di un fiume ogni minuto.

Pertanto ho una serie di letture dal Gennaio a Dicembre ad intervalli di un minuto e quindi 525600 letture.

Adesso dividendo le letture per mese ed usando la funzione "media" ottengo la media mensile ed ovviamente anche quella annuale.

Il problema è che a volte i dati non vengono registrati e quindi la media non è veritiera ma essendo una centrale idroelettrica ho la possibilità di sapere la media effettiva conoscendo i KWh erogati ogni mese.

La mia domanda è: se fosse possibile avendo un valore medio sicuro creare un elenco di numeri casuali per ogni minuto del mese che ovviamente la media sia il mio valore medio.

Inoltre avrei bisogno che mi generasse numeri interi con 2 decimali.

Io ho usato questa funzione =CASUALE.TRA(320;620)*1,01 per creare un elenco contenente il valore medio reale e moltiplicato per 1,01 per avere i decimali altrimenti erano tutti valori interi.

Vorrei fare un codice vba sotto un command button anche per evitare il continuo aggiornarsi dei valori ad ogni inserimento dei dati nelle celle.

Grazie anticipatamente 

Giuseppe

Answer 1

Ciao Giuseppe,

hai soddisfatto tutti i miei capricci, siete fantastici.

Adesso ho tutte le varie combinazioni possibili.

Va perfettamente.

Bene!  Ti ringrazio del cortese riscontro.

Una sola domanda, mi consigli di fare fogli distinti per i mesi in modo da essere facilitato el spostare i dati in access o posso fare come avevo iniziato e cioè un solo foglio di calcolo con i mesi separati da una colonna?

Questo perchè poi dovrò aggiungere dei grafici e quindi non volevo creare troppi fogli su questo file.

Credo che la scelta sia tua ed, a mio avviso, sia principalmente dettata dal successivo utilizzo del file di Excel: se la raison d` ê tre del file fosse la manipolazione di dati, prima di alimentare Microsoft Access, si potrebbe prendere in considerazione un singolo foglio; se, invece, Excel dovesse  essere utilizzato per analisi successivi, credo che si possa anche adottare un approccio a più fogli.

Detto questo, se l'intenzione fosse di sfruttare gli stessi grafici per tutti i dati mensile,  questo militerebbe contro una proliferazione di fogli; mentre il numero di fogli dovrebbe aver relativamente poco effetto sulla dimensione del file, credo un maggior numero di grafici possa averne un notevole effetto deleterio.

Quindi, ripeterei, la scelta deve essere tua!

Ci sono  diverse considerazioni per quanto riguarda l'esportazione dei dati interessati da Excel, oppure il loro importazione in Microsoft Access, ma credo sia meglio che queste siano indirizzate da noi nel tuo nuovo thread! 

Se, come credo, questo thread sia giunto ad una conclusione positiva, per chiuderlo, vorrei gentilmente chiederti di segnare la mia risposta come Risposta. In questo modo, tu aiuterai anche coloro che potrebbero cercare soluzioni ai problemi simili negli archivi della Community.

===

Regards,

Norman

Answer 2

Ciao Giuseppe,

Per gestire la possibiltà che non ci sia un periodo di manutenzione e, in tal caso, di applicare il codice al mese intiero, prova la seguente nuova versione:

'=========>>

Option Explicit

'--------->>

Public Sub Tester3()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim rngPrimaData, rngUltimaData

    Dim rngPrimoOrario As Range, rngUltimoOrario As Range

    Dim rigaStart As Long, rigaFine As Long

    Dim riga2Start As Long, riga2Fine As Long

    Dim rngMediaValle As Range, rngScartoMediaValle As Range

    Dim Rng As Range, Rng2 As Range, Rng3 As Range

    Dim rArea As Range

    Dim LRow As Long

    Dim iMin As Long, iMax As Long

    Dim Criterio1 As Double, Criterio2 As Double

    Dim bManutenzione As Boolean

    Const cellaPrimaData As String = "C4"                                '<<=== Modifica

    Const cellaUltimaData As String = "D4"               '<<=== Modifica

    Const cellaPrimoOrario As String = "C6"                             '<<=== Modifica

    Const cellaUltimoOrario As String = "D6"                           '<<=== Modifica

    Const cellaMediaValle As String = "B3"                               '<<=== Modifica

    Const cellaScartoMediaValle As String = "B5"                    '<<=== Modifica

    Const iPrimaRigaAs Long = 14 '<<=== Modifica

    bManutenzione = True

    Set WB = ThisWorkbook

    Set SH = WB.ActiveSheet

    With SH

        Set rngPrimaData = .Range(cellaPrimaData)

        Set rngUltimaData = .Range(cellaUltimaData)

        Set rngPrimoOrario = .Range(cellaPrimoOrario)

        Set rngUltimoOrario = .Range(cellaUltimoOrario)

        Set rngMediaValle = .Range(cellaMediaValle)

        Set rngScartoMediaValle = .Range(cellaScartoMediaValle)

        LRow = LastRow(SH, .Columns("A:A"))

        With .Columns(1)

            If IsEmpty(rngPrimaData.Value) _

               Or IsEmpty(rngUltimaData.Value) Then

                bManutenzione = False

                Set Rng = .Cells(iPrimaRiga).Offset(0, 3). _

                          Resize(LRow - iPrimaRiga + 1)

            End If

            If bManutenzione Then

                Criterio1 = CDbl(rngPrimaData.Value + rngPrimoOrario)

                Criterio2 = CDbl(rngUltimaData + rngUltimoOrario)

                rigaStart = SH.Columns(1).Find( _

                            What:=CDate(Criterio1), _

                            After:=.Cells(iPrimaRiga - 1), _

                            LookIn:=xlFormulas, _

                            LookAt:=xlPart, _

                            SearchOrder:=xlByRows, _

                            SearchDirection:=xlNext, _

                            MatchCase:=False).Row

                rigaFine = SH.Columns(1).Find( _

                           What:=CDate(Criterio1), _

                           After:=.Cells(iPrimaRiga - 1), _

                           LookIn:=xlFormulas, _

                           LookAt:=xlPart, _

                           SearchOrder:=xlByRows, _

                           SearchDirection:=xlPrevious, _

                           MatchCase:=False).Row

                riga2Start = SH.Columns(1).Find( _

                             What:=CDate(Criterio2), _

                             After:=.Cells(iPrimaRiga - 1), _

                             LookIn:=xlFormulas, _

                             LookAt:=xlPart, _

                             SearchOrder:=xlByRows, _

                             SearchDirection:=xlNext, _

                             MatchCase:=False).Row

                riga2Fine = SH.Columns(1).Find( _

                            What:=CDate(Criterio2), _

                            After:=.Cells(iPrimaRiga - 1), _

                            LookIn:=xlFormulas, _

                            LookAt:=xlPart, _

                            SearchOrder:=xlByRows, _

                            SearchDirection:=xlPrevious, _

                            MatchCase:=False).Row

                Set Rng2 = .Cells(iPrimaRiga).Resize(rigaStart - iPrimaRiga)

                Set Rng3 = .Cells(riga2Fine + 1).Resize(LRow - riga2Fine)

                '            End With

                Set Rng = Union(Rng2, Rng3).Offset(, 3)

            End If

            iMin = rngMediaValle.Value - rngScartoMediaValle.Value

            iMax = rngMediaValle.Value + rngScartoMediaValle.Value

        End With

    End With

    On Error GoTo XIT

    Application.ScreenUpdating = False

    With Rng

        .NumberFormat = "0.00"

        .Formula = "=RANDBETWEEN(" & iMin & "," & iMax & ")*1.01"

        For Each rArea In Rng.Areas

            With rArea

                .Select

                .Value = .Value

                .Interior.Color = vbYellow   '\ Solo per facilitare le prove!

            End With

        Next rArea

    End With

XIT:

    Application.ScreenUpdating = True

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       After:=Rng.Cells(1), _

                       LookAt:=xlWhole, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<=========

Ho caricato un nuvo file di prova Giuseppe#2_20160211.xlsm a:

https://www.dropbox.com/s/ufpsz3pjmfesep2/Giuseppe%232_20160211.xlsm?dl=0

===

Regards,

Norman

Answer 3

Ciao Giuseppe,

è fantastico ma avrei bisogno di due varianti per avere perfettamente ciò che mi serve.

Prima variante: vorrei usare una cella ove risiede il valore medio effettivo ed un'altra cella ove risiede il range che voglio per poi generare i numeri casuali.

Ho provato a fare come segue ma non funziona:

Dim Min As Integer

Dim Max As Integer

       

Min = Range("B3") - Range("B5")

Max = Range("B3") + Range("B5")

    Set SH = ActiveSheet

    With SH

        LRow = LastRow(SH, .Columns("A:A"))

        Set Rng = .Range("C10:C" & LRow)

    End With

    With Rng

        .NumberFormat = "0.00"

.Formula = "=RANDBETWEEN(Min,Max)*1.01"

        .Value = .Value

    End With

Per la prima variante, prova la seguente versione nella quale le modifiche sono evidenziate in grassetto:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, rCell As Range

    Dim LRow As Long

    Dim iMin As Long, iMax As Long

    Const iPrimaRiga As Long = 7                                '<<=== Modifica

    Set SH = ActiveSheet

    With SH

        LRow = LastRow(SH, .Columns("A:A"))

        Set Rng = .Range("B" & iPrimaRiga & ":B" & LRow)

        iMin = .Range("B3").Value - .Range("B5").Value

iMax = .Range("B3").Value + .Range("B5").Value

    End With

    With Rng

        .NumberFormat = "0.00"

        .Formula = "=RANDBETWEEN(" & iMin & "," & iMax & ")*1.01"

        .Value = .Value

    End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<=========

Seconda variante:

Inserire a mano due date in due celle, in caso ci siano dei lavori di manutenzione e quindi tra quelle due date non ci dovrà essere nessun valore.

Tipo: lavori dal 10/01 al 15/01

Random su tutto il mese tranne dal 10/01 al 15/01.

Ciao Giuseppe,

Per questa seconda variante, prova la seguente versione nella quale le modifiche sono evidenziate in grassetto:

'=========>>

Option Explicit

'--------->>

Public Sub Tester2()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, rCell As Range

    Dim RngStart As Range, RngEnd As Range

    Dim LRow As Long

    Dim iMin As Long, iMax As Long

    Const CellaPrimaData As String = "E3"                            '<<=== Modifica

    Const CellaUltimaData As String = "E5"                           '<<=== Modifica

    Const iPrimaRiga As Long = 7                                                  '<<=== Modifica

    Set SH = ActiveSheet

    With SH

        Set RngStart = SH.Columns(1).Find( _

What:=.Range(CellaPrimaData).Value, _

After:=.Range("A6"), _

LookIn:=xlValues, _

LookAt:=xlWhole)

Set RngEnd = SH.Columns(1).Find( _

What:=.Range(CellaUltimaData).Value, _

After:=.Range("A6"), _

LookIn:=xlValues, _

LookAt:=xlWhole)

        Set Rng = .Range(RngStart, RngEnd).Offset(0, 1)

        iMin = .Range("B3").Value - .Range("B5").Value

        iMax = .Range("B3").Value + .Range("B5").Value

    End With

    With Rng

        .NumberFormat = "0.00"

        .Formula = "=RANDBETWEEN(" & iMin & "," & iMax & ")*1.01"

        .Value = .Value

    End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       After:=Rng.Cells(1), _

                       LookAt:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<=========

Ho aggiornato il mio file di prova Giuseppe20160208.xlsm a:

https://www.dropbox.com/s/fwz258pj818tfjp/Giuseppe20160208.xlsm?dl=0

===

Regards,

Norman

Answer 4

Ciao Norman,

è fantastico ma avrei bisogno di due varianti per avere perfettamente ciò che mi serve.

Prima variante: vorrei usare una cella ove risiede il valore medio effettivo ed un'altra cella ove risiede il range che voglio per poi generare i numeri casuali.

Ho provato a fare come segue ma non funziona:

Dim Min As Integer

Dim Max As Integer

Min = Range("B3") - Range("B5")

Max = Range("B3") + Range("B5")

    Set SH = ActiveSheet

    With SH

        LRow = LastRow(SH, .Columns("A:A"))

        Set Rng = .Range("C10:C" & LRow)

    End With

    With Rng

        .NumberFormat = "0.00"

        .Formula = "=RANDBETWEEN(Min,Max)*1.01"

        .Value = .Value

    End With

Seconda variante:

Inserire a mano due date in due celle, in caso ci siano dei lavori di manutenzione e quindi tra quelle due date non ci dovrà essere nessun valore.

Tipo: lavori dal 10/01 al 15/01

Random su tutto il mese tranne dal 10/01 al 15/01.

Spero sia possibile così avrei risolto tutti i miei problemi.

Grazie ancora a tutti voi che mi aiutate sempre.

Saluti

Giuseppe

Spero si possa fare

Answer 5

Ciao Giuseppe,

Ipotizzando che i dati di ogni mese siano su un foglio dedicato e che le date per ogni mese inizino nella cella A2, prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, rCell As Range

    Dim LRow As Long

    Dim CalcMode As Long

    Set SH = ActiveSheet

    With SH

        LRow = LastRow(SH, .Columns("A:A"))

        Set Rng = .Range("B2:B" & LRow)

    End With

    With Rng

        .NumberFormat = "0.00"

        .Formula = "=RANDBETWEEN(320,620)*1.01"

        .Value = .Value

    End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<=========

Potresti scaricare il mio file di prova Giuseppe20160208.xlsm a:

https://www.dropbox.com/s/fwz258pj818tfjp/Giuseppe20160208.xlsm?dl=0

===

Regards,

Norman