Problema Redim Preserve

Hai un problema con Excel?

Nuova discussione

Problema Redim Preserve
di Lollo (utente non iscritto) data: 17/06/2017 18:38:44
Buonasera a tutti. Non sono molto pratico di vba e vorrei capire una questione riguardo l'uso del Redim preserve. Il codice in allegato gira secondo quanto richiesto dalla consegna, ma non capisco perché mi funziona solo mettendo il redim preserva sia all'inizio sia alla fine del codice per caricare il vettore.
È possibile questo o sono io che ho sbagliato qualcosa?
Grazie in anticipo

Option Explicit
Option Base 1

Sub Simula(X() As Double, Y() As Double, ByVal D As Integer, ByVal M As Integer)
Dim somma1 As Double, somma2 As Double
Dim j As Integer
Dim k As Integer
Dim coda() As Double
Dim serviti() As Double
Dim rifiutati() As Double
Dim c As Double
Dim nr As Integer
Dim cumulata As Double
Dim i As Integer
Dim primo As Double
Dim secondo As Double
Dim casuale1 As Integer
Dim casuale2 As Integer
Dim nr1 As Integer
Dim nr2 As Integer
Dim cumulata1 As Double
Dim cumulata2 As Double






'controllo densita di probabilita

somma1 = 0
For j = LBound(X, 1) To UBound(X, 1)
    somma1 = somma1 + X(j, 1)
Next

If somma1 <> 1 Then
    MsgBox ("Errore")
End If

somma2 = 0
For k = LBound(Y, 1) To UBound(Y, 1)
    somma2 = somma2 + Y(k, 1)
Next

If somma2 <> 1 Then
    MsgBox ("Errore")
End If

'fine controllo densita

'istante 1

c = Rnd()
nr = 1
cumulata = X(1, 1)
Do While c > cumulata
    cumulata = cumulata + X(nr + 1, 1)
    nr = nr + 1
Loop

ReDim Preserve rifiutati(1)
ReDim Preserve coda(1)
If X(nr, 2) <= M Then
    coda(1) = X(nr, 2)
    rifiutati(1) = 0
  
Else
    coda(1) = M
    rifiutati(1) = X(nr, 2) - M

End If
    
ReDim Preserve coda(1)
ReDim Preserve rifiutati(1)

    
ReDim Preserve serviti(1)
serviti(1) = 0
ReDim Preserve serviti(1)

MsgBox ("entrano" & X(nr, 2))
MsgBox ("coda" & coda(1))
MsgBox ("serviti" & serviti(1))
MsgBox ("rifiutati" & rifiutati(1))

'fine istante 1 e inizio 2,3,4....D

For i = 2 To D
    
    primo = Rnd()
    nr1 = 1
    cumulata1 = X(1, 1)
    Do While primo > cumulata1
        cumulata1 = cumulata1 + X(nr1 + 1, 1)
        nr1 = nr1 + 1
    Loop
    casuale1 = X(nr1, 2)
    
    secondo = Rnd()
    nr2 = 1
    cumulata2 = Y(1, 1)
    Do While secondo > cumulata2
        cumulata2 = cumulata2 + Y(nr2 + 1, 1)
        nr2 = nr2 + 1
    Loop
    casuale2 = X(nr2, 2)
    
ReDim Preserve serviti(i)
If casuale2 >= coda(i - 1) Then
    serviti(i) = coda(i - 1)
Else
    serviti(i) = casuale2
End If

ReDim Preserve serviti(i)

ReDim Preserve coda(i)
ReDim Preserve rifiutati(i)
 

If casuale2 < coda(i - 1) Then
    If casuale1 + coda(i - 1) - casuale2 <= M Then
        coda(i) = casuale1 + coda(i - 1) - casuale2
        rifiutati(i) = 0
    Else
        coda(i) = M
        rifiutati(i) = casuale1 + coda(i - 1) - casuale2 - M
    End If
Else
    If casuale1 <= M Then
        coda(i) = casuale1
        rifiutati(i) = 0
    Else
        coda(i) = M
        rifiutati(i) = casuale1 - M
    End If
End If

ReDim Preserve coda(i)
ReDim Preserve rifiutati(i)


MsgBox ("entrano" & casuale1)
MsgBox ("ne servono" & casuale2)
MsgBox ("coda" & coda(i))
MsgBox ("serviti" & serviti(i))
MsgBox ("rifiutati" & rifiutati(i))



Next

End Sub


Sub prova()
Dim R(4, 2) As Double
Dim U(3, 2) As Double

R(1, 1) = 0.2
R(1, 2) = 2
R(2, 1) = 0.3
R(2, 2) = 1
R(3, 1) = 0.3
R(3, 2) = 4
R(4, 1) = 0.2
R(4, 2) = 3

U(1, 1) = 0.3
U(1, 2) = 3
U(2, 1) = 0.4
U(2, 2) = 1
U(3, 1) = 0.3
U(3, 2) = 2

Call Simula(R(), U(), 5, 3)


End Sub

di patel data: 17/06/2017 18:51:09
in VBA gli array devono essere dimensionati, o lo fai subito se ne conosci le dimensioni o lo fai dopo con redim.
di Nick (utente non iscritto) data: 17/06/2017 21:43:23
Puoi scrivere, all'inizio della funzione

Dim coda() As Integer

Quando ti serve la prima volta bast

Redim Preserve coda(1)

in seguito

Redim Preserve coda(15)
di Nick (utente non iscritto) data: 17/06/2017 21:44:53
Meglio ...

Puoi scrivere, all'inizio della funzione

Dim coda() As Integer

Quando ti serve la prima volta basta

Redim coda(1)

in seguito

Redim Preserve coda(15)
di Vecchio Frac data: 18/06/2017 18:48:52
Trovo abbastanza inutile e ridondante (per l'esempio fatto) continuare a ridimensionare le variabili coda, serviti e rifiutati preservando i valori ad ogni ciclo, se sai già che i valori massimi dell'indice arrivano fino a D. Fai subito un dim coda (D) e sei a posto per tutto il resto del codice senza preoccuparti dei ridimensionamenti.
di Vecchio Frac data: 18/06/2017 18:53:02
Aggiungo che sarebbe utile avere un risultato finale, da comparare con il codice che proponi, e vedere cosa c'è che non va.
di Lollo (utente non iscritto) data: 18/06/2017 18:55:16
Dim coda(D) è esattamente quello che avevo pensato di fare, ma continua ad uscirmi un errore dicendo che la dimensione deve essere costante e non mi accetta "D" come dimensione.
di Vecchio Frac data: 18/06/2017 18:57:20
Sì è vero l'ho verificato anch'io ma la soluzione è semplice (scusa se non l'ho detto subito, mi sembrava abbastanza banale):
Dim coda() As Double
Dim serviti() As Double
Dim rifiutati() As Double

e subito sotto

ReDim coda(D) As Double
ReDim serviti(D) As Double
ReDim rifiutati(D) As Double
di Lollo (utente non iscritto) data: 18/06/2017 18:58:52
Giusto non ci avevo pensato. Grazie mille
di Nick (utente non iscritto) data: 18/06/2017 20:10:15
Te l'avevo appena scritto ...
di Vecchio Frac data: 18/06/2017 20:36:04
E' vero. Solo che ci aveva confuso con i Preserve (e non è una parolaccia ^_^)

Vuoi Approfondire?