Scelta intervallo

Hai un problema con Excel?

Nuova discussione

Scelta intervallo
di ottomila (utente non iscritto) data: 22/03/2014 18:19:44
Salve a tutti,
mi rivolgo alle vostre menti eccelse per poter compilare una funzione di scelta con il codice VBA.
Devo fare in modo di attribuire a ciascuna zona il numero di giri di apertura per delle valvole.
Sono due zone distinte: la prima zona è chiamata [Dp_terra] e la seconda [Dp_primo].
Ho stabilito il valore più alto per ogni zona e vorrei che quando inserisco un numero in ognuna, il codice individui quella specifica e mi faccia i calcoli.
Vorrei anche fare in modo che la procedura individui: le celle vuote, gli zeri e il testo come esclusi dal calcolo.
Ogni circuito potrebbe avere anche un diametro diverso, perciò il procedimento dovrà scegliere quello attribuito alla valvola specifica.
Ho abbozzato nel VBA un po' di codice, ma funziona solo in parte.
Da notare che i diametri in pollici ["] li ho sostituiti con due apostrofi perché nella procedura VBA non me li leggeva correttamente con le virgolette.
Spero di essermi spiegato correttamente. È possibile risolvere il problema?
Grazie molte

Option Explicit
Function taratura(Q, Dpcir As Variant, diamval As String)
Dim giri, Ddiff, Dp As Long
Dim Dp_terra, Dp_primo As Range
Dim DpmaxPT, DpmaxP1 As Variant
Set Dp_terra = Worksheets(1).Range("F4:F9")
Set Dp_primo = Worksheets(1).Range("F11:F18")
'If IsEmpty(Range(Dp_terra)) Or IsEmpty(Range(Dp_primo)) Then:
'Exit Function
DpmaxPT = WorksheetFunction.Max(Dp_terra)
DpmaxP1 = WorksheetFunction.Max(Dp_primo)
If Dpcir(Dp_terra(Dpcir)) Then
        DpcirPT = Dpcir
        Ddiff = DpmaxPT - Dpcir
      If diamval = "3/8''" And Ddiff <= Dpmax Then
      Dp = 3.4826 * Q ^ 1.909
            If Dp <= Ddiff Then
            giri = "¾": GoTo ok
            End If
      Dp = 2.418 * Q ^ 1.7925
           If Dp <= Ddiff Then
            giri = "1": GoTo ok
            End If
      Dp = 0.8027 * Q ^ 1.7982
            If Dp <= Ddiff Then
            giri = "1 ½": GoTo ok
            End If
      Dp = 0.1222 * Q ^ 1.908
            If Dp <= Ddiff Then
            giri = "2": GoTo ok
            End If
      Dp = 0.0166 * Q ^ 1.9727
            If Dp <= Ddiff Then
            giri = "2 ½": GoTo ok
            End If
      Dp = 0.0035 * Q ^ 2.0706
            If Dp <= Ddiff Then
            giri = "3": GoTo ok
            End If
      Dp = 0.0016 * Q ^ 2.0403
            If Dp <= Ddiff Then
             giri = "4": GoTo ok
            End If
      Dp = 0.0007 * Q ^ 2.1117
            If Dp <= Ddiff Then
           giri = "A": GoTo ok
            Else
            giri = "Ap"
            End If
End If
 If diamval = "1/2''" And Ddiff <= DpmaxPT Then
      Dp = 3.205 * Q ^ 1.6734
            If Dp <= Ddiff Then
            giri = "½": GoTo ok
            End If
      Dp = 1.072 * Q ^ 1.67
           If Dp <= Ddiff Then
            giri = "¾": GoTo ok
            End If
      Dp = 0.4727 * Q ^ 1.6783
            If Dp <= Ddiff Then
            giri = "1": GoTo ok
            End If
      Dp = 0.216 * Q ^ 1.7158
            If Dp <= Ddiff Then
            giri = "1 ½": GoTo ok
            End If
      Dp = 0.1533 * Q ^ 1.7264
            If Dp <= Ddiff Then
            giri = "2": GoTo ok
            End If
      Dp = 0.0984 * Q ^ 1.7527
            If Dp <= Ddiff Then
            giri = "3": GoTo ok
            End If
      Dp = 0.0442 * Q ^ 1.842
            If Dp <= Ddiff Then
             giri = "4": GoTo ok
            End If
      Dp = 0.0167 * Q ^ 1.9003
            If Dp <= Ddiff Then
             giri = "4 ½": GoTo ok
            End If
      Dp = 0.0066 * Q ^ 1.9063
            If Dp <= Ddiff Then
             giri = "5": GoTo ok
            End If
      Dp = 0.0025 * Q ^ 1.8928
            If Dp <= Ddiff Then
           giri = "A": GoTo ok
            Else
            giri = "Ap"
            End If
      End If
 If (Dp_primo(Dpcir)) Then
       DpmaxP1 = Dpcir
           Ddiff = DpmaxP1 - Dpcir
   If diamval = "3/8''" And Ddiff <= DpmaxP1 Then
      Dp = 3.4826 * Q ^ 1.909
            If Dp <= Ddiff Then
            giri = "¾": GoTo ok
            End If
      Dp = 2.418 * Q ^ 1.7925
           If Dp <= Ddiff Then
            giri = "1": GoTo ok
            End If
      Dp = 0.8027 * Q ^ 1.7982
            If Dp <= Ddiff Then
            giri = "1 ½": GoTo ok
            End If
      Dp = 0.1222 * Q ^ 1.908
            If Dp <= Ddiff Then
            giri = "2": GoTo ok
            End If
      Dp = 0.0166 * Q ^ 1.9727
            If Dp <= Ddiff Then
            giri = "2 ½": GoTo ok
            End If
      Dp = 0.0035 * Q ^ 2.0706
            If Dp <= Ddiff Then
            giri = "3": GoTo ok
            End If
      Dp = 0.0016 * Q ^ 2.0403
            If Dp <= Ddiff Then
             giri = "4": GoTo ok
            End If
      Dp = 0.0007 * Q ^ 2.1117
            If Dp <= Ddiff Then
           giri = "A": GoTo ok
            Else
            giri = "Ap"
            End If
End If
 If diamval = "1/2''" And Ddiff <= DpmaxP1 Then
      Dp = 3.205 * Q ^ 1.6734
            If Dp <= Ddiff Then
            giri = "½": GoTo ok
            End If
      Dp = 1.072 * Q ^ 1.67
           If Dp <= Ddiff Then
            giri = "¾": GoTo ok
            End If
      Dp = 0.4727 * Q ^ 1.6783
            If Dp <= Ddiff Then
            giri = "1": GoTo ok
            End If
      Dp = 0.216 * Q ^ 1.7158
            If Dp <= Ddiff Then
            giri = "1 ½": GoTo ok
            End If
      Dp = 0.1533 * Q ^ 1.7264
            If Dp <= Ddiff Then
            giri = "2": GoTo ok
            End If
      Dp = 0.0984 * Q ^ 1.7527
            If Dp <= Ddiff Then
            giri = "3": GoTo ok
            End If
      Dp = 0.0442 * Q ^ 1.842
            If Dp <= Ddiff Then
             giri = "4": GoTo ok
            End If
      Dp = 0.0167 * Q ^ 1.9003
            If Dp <= Ddiff Then
             giri = "4 ½": GoTo ok
            End If
      Dp = 0.0066 * Q ^ 1.9063
            If Dp <= Ddiff Then
             giri = "5": GoTo ok
            End If
      Dp = 0.0025 * Q ^ 1.8928
            If Dp <= Ddiff Then
           giri = "A": GoTo ok
            Else
            giri = "Ap"
            End If
      End If
End If
End If
ok: taratura = giri
End Function

Scelta intervallo
di ottomila (utente non iscritto) data: 22/03/2014 18:38:16
Allego il file corretto.
Mi scuso dell'accaduto.
di Vecchio Frac data: 22/03/2014 18:38:22
Nel file allegato la denominazione delle zone non sembra congruente.
Guarda per esempio le definizioni dei range nel codice e guarda a cosa puntano nel foglio:
Set Dp_terra = Worksheets(1).Range("F4:F9") Set Dp_primo = Worksheets(1).Range("F11:F18")

Inoltre non sono dichiarate DpcirPT e Dpmax (sono di tipo Single?).

Il punto
If Dpcir(Dp_terra(Dpcir)) Then
mi lascia un po' perplesso.
Cosa deve risolvere quella condizione? puoi dirlo a parole tue :)
Infine, una serie di più chiari Select Case aiuterà a sbrogliare la matassa di If ^_^
I diametri in pollici li puoi sostituire con Chr(34) che corrisponde al carattere virgolette; solitamente si usa dichiarare una costante stringa, es. QUOTE da usare nel corso del codice:
Const QUOTE As String = """" (bisogna specificare quattro virgolette... strano ma funziona)
di Vecchio Frac data: 22/03/2014 18:40:40
Mentre scrivevo hai allegato un nuovo file ma la problematica segnalata sui range rimane :)
Scelta intervallo
di ottomila (utente non iscritto) data: 22/03/2014 18:44:13
Ciao Vecchio Frac, so che sei un maestro nel VBA.
Mi spiego in parole povere: questa funzione dovrebbe calcolarmi (secondo le formule scritte) i valori di apertura di determinate valvole, ma vorrei che, immettendo i valori nelle rispettive zone
[Dp_terra] e [Dp_primo], facesse i calcoli semplicemente scegliendo quella specifica con l'immissione da tastiera.
Scelta intervallo
di ottomila (utente non iscritto) data: 22/03/2014 18:50:57
Vecchio Frac,
non prendere in considerazione le righe del codice, perché sono andato a tentativi...
Magari si potrebbe accorciare di parecchio tuttoil codice, esclusi i calcoli per ogni diametroi che sono tassativi.
Vi ringrazio ancora.
Scelta intervallo
di ottomila (utente non iscritto) data: 22/03/2014 19:01:37
La parte di codice
DpmaxPT = WorksheetFunction.Max(Dp_terra)
DpmaxP1 = WorksheetFunction.Max(Dp_primo)
mi calcola il valore più alto delle zone e questo va bene per entrambi le zone. A questo punto il codice deve trovare la differenza tra il valore più alto sopra calcolato ed il valore immesso in ogni cella delle rispettive zone scegliendo il diametro inserito a fianco e calcolando i giri di apertura.
di Vecchio Frac data: 22/03/2014 20:45:04
E nel file "Tarature (corretto)" cosa c'è che non va? cioè qual è il problema che non risolvi? Per quel che ne so io, i risultati della funzione tarature sono corretti :)
Comunque è sempre quel "If IsEmpty(Dp_terra(Dpcir)) Then" che mi suona male... stai cercando di recuperare la cella nella posizione che corrisponde al valore di un'altra cella: nel primo caso ad esempio 598. La cella 598 del range dp_terra non esiste... capisci che c'è qualcosa che non va ^_^
Cosa volevi cercare di farti restituire in quel punto?
E la domanda successiva è, volevi anche ottimizzare tutto vero?
Scelta intervallo
di ottomila (utente non iscritto) data: 23/03/2014 13:39:31
Ciao Vecchio Frac, volevo spiegarti nel modo più semplice quello che la funzione dovrebbe fare.
Il foglio di calcolo è composto da due zone distinte: [Dp_terra] e [Dp_primo] impostate su degli intervalli di celle con il comado [Set]. In ognuna di queste zone sono inseriti dei dati i cui valori massimi di ciascuna zona sono calcolati con [DpmaxPT = WorksheetFunction.Max(Dp_terra)] e [DpmaxP1 = WorksheetFunction.Max(Dp_primo)]. Dal valore massimo della zona, devo detrarre il valore inserito nella cella ed avere la differenza [Ddiff = DpmaxPT - Dpcir] per poi proseguire con il resto della routine. Lasciando perdere il codice [sEmpty(Dp_terra(Dpcir))] che non centra (che ho scritto io per tentativi), descrivo il procedimento che la funzione dovrebbe fare. Cambiando i dati di una cella situata in una delle due zone, la funzione deve trovarmi con i calcoli il numero di giri secondo le formule scritte. Il problema sta nell'identificare la zona dalla quale immetto o cambio i dati e procedere poi per scelta sui vari diametri (di questa determinata zona) dando i risultati secondo i calcoli scritti. Sicuramente si potrà usare i calcoli dei due diametri scritti in un solo procedimento uguale per le due zone senza ripetere la trafila dei codici, ma non so come fare.
A disposizione per ulteriori chiarimenti.
di Vecchio Frac data: 23/03/2014 15:22:08
Ho rivisto un po' il tutto.
Credo che funzioni (ho rispettato le tue formule) ma devi verificare i valori :)
Ho generalizzato quindi il codice è ridotto alla metà.
Mi fa senso utilizzare GoTo che andrebbe evitato sempre: con calma vedo se riesco a ottimizzare meglio.
Allego il file "tarature (vfrac).rar".
di Vecchio Frac data: 23/03/2014 16:25:20
Mi sono migliorato eliminando i Goto... prova la versione "tarature (vfrac 2)" e poi dimmi.
Scelta intervallo
di ottomila (utente non iscritto) data: 23/03/2014 17:25:26
Perfetto!! Mi devo solo inchinare alla vostra maestria
Era proprio quello che cercavo. Grazie mille Vecchio Frac, senza di voi non ci sarei mai arrivato. La routine la potevo forse fare anche con l'evento [Worksheet_Change] ma preferivo applicare una Function per la sua procedura…"silente" e scorrevole. Tra non molto avrò da sottoporvi un vero grattacapo di calcolo iterativo in VBA che a dir poco sono circa 8 mesi che ci lavoro, ma non ne vengo proprio fuori. Solo tu o voi potrete risolverlo.
Ringrazio ancora tutti voi e mi scuso se ho approfittato del vostro prezioso tempo.
Ciao.
di Vecchio Frac data: 23/03/2014 17:46:02
Stai facendo due grandi sbagli.
Uno è qui:
cit. "so che sei un maestro nel VBA"
reiterato qui:
cit. "Mi devo solo inchinare alla vostra maestria"
e l'altro è qui:
cit. "senza di voi non ci sarei mai arrivato"
Mai dare titoli, che generano solo confusione ^_^ e poi mai sottovalutarsi ^_^
In fondo la formula era già scritta e dipinta chiaramente, io ho solo dato un'aggiustatina.
Che poi, attenzione se sposti la tabella o ampli i range: io ho eliminato un po' di riferimenti riscrivendoli a crudo con Range("...") ma se preferisci puoi tornare alla definizione con Set.
Attendiamo quindi con una certa curiosità il "grattacapo iterativo" ^_^

Vuoi Approfondire?