Condividi:        

MACRO richiamo dati se verificata condizione

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

MACRO richiamo dati se verificata condizione

Postdi darix » 13/11/09 11:21

Salve a tutti, vi espongo subito il mio problema,

ho un file excel composto di duefogli:
-il primo è una Maschera Dati in cui l'utente debba inserire parametri clinici relativi alla visita di un paziente
-il secondo è l'archivio che memorizza in righe contigue (da A6 a EW6) i parametri inseriti nella maschera

Ho già creato:
- una macro che memorizza i campi della Maschera Dati nelle righe del foglio Archivio in modo che la visita più recente sia posta nella riga più in alto
-una macro che aggiorna il contatore visite e ripulisce i campi della Maschera Dati er un nuovo inserimento

Ora, il mio problema è creare una macro che consenta il richiamo dei dati, GIA' salvati nelle righe del foglio Archivio, nei campi della maschera Dati, QUANDO l'utente digita nome e cognome del paziente di cui vuole i parametri. Lo scopo è consentire al medico (l'utente del mio file) di non scrivere tutto di nuovo ogni volta di un paziente se da una visita all'altra i parametri sono stabili, ma, richiamando i dati dell'ULTIMA VISITA A LUI ASSOCIATA (e quindi relativi alla riga più in alto del folgio archivio) cambiare ciò che vuole qua e là e poi procedere all'archiviazione..

Spero di essere stato chiaro
Grazie mille per ogni anima buona che vorrà lenire le mie sofferenze!!

Dario
darix
Newbie
 
Post: 6
Iscritto il: 13/11/09 11:02

Sponsor
 

Re: MACRO richiamo dati se verificata condizione

Postdi Anthony47 » 13/11/09 17:49

Premetto che se il mio medico prendesse i risultati di una visita dal referto precedente io non mi sentirei tanto tranquillo...
Comunque, bisognerebbe sapere se il file e' usato da un solo medico e come e' organizzato l' archivio; visto che non mi sembri alle prime armi ti do' solo delle linee guida su cui lavorare.
Per comodita' assegni un "nome" alla cella in cui si inserisce il nominativo, es la chiami "paziente"; supponiamo che lo storico degli esami sia in foglio "Storico", dove il nominativo e' in col A.

Userai poi un ciclo del tipo:
Codice: Seleziona tutto
For I = Sheets("Storico").Cells(Rows.count, 1).End(xlup).Row To 1 Step -1
If Sheets("Storico").Cells(I, 1).value = Range("Paziente").value Then
'qui le istruzioni per prelevare tutte le celle della riga N° I
'  e posizionarle nella tua maschera
'
Exit Sub
End If
Next I

Se Storico comprende esiti di piu' medici, sara' necessario inserire nel ciclo anche la verifica che quella riga appartiene al medico corrente; idem se ci sono piu' tipologie di visite.

Come farti un pulsante per associargli la macro risultante penso non sara' un problema.

Se con questi spunti non risolvi, posta ancora descrivendo anche il tracciato record su Storico; comunque fai sapere dove arrivi.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: MACRO richiamo dati se verificata condizione

Postdi darix » 15/11/09 11:51

Ciao Anthony e grazie per avermi risposto,
effettivamente ammetto che possa sembrare un pò inquietante il modus operandi dei medici che ti ho descritto!!
ma si tratta di un file che deve raccogliere parametri rilevati da un sistema telemedicale (per una sperimentazione) di pazienti affetti da patologie croniche, per le quali quindi la situazione è sostanzialmente invariata e poco variabile.

Serve quindi a raccogliere i dati di un monitoraggio più cha altro.

Per maggiore chiarezza ti posto i link agli screenshot dei 2 fogli di cui è composto il file:
1. Maschera Dati: http://www.megaupload.com/?d=UB4I8H3E
2. Archivio: http://www.megaupload.com/?d=3DR6QZ20

Il file sarà utilizzato da un solo medico, quindi i pazienti inseriti faranno riferimento solo a lui.
L'archivio è strutturato in una serie di righe in cui per ogni visita sono associati nome e cognome del paziente e i parametri a lui relativi (quindi per uno stesso paziente possono esserci più record riga)

Grazie per la dritta del ciclo la proverò domani...a questo proposito volevo solo chiederti se l'indice vada dichiarato inizialmente o no

Grazie ancora

Dario
darix
Newbie
 
Post: 6
Iscritto il: 13/11/09 11:02

Re: MACRO richiamo dati se verificata condizione

Postdi Flash30005 » 15/11/09 12:44

Ho scaricato le immagini e... pensavo che, forse, sarebbe meglio avere un foglio per ogni paziente (come archivio) e poi fare le operazioni che richiedevi con il foglio Maschera,
ad ogni nuovo paziente si crea automaticamente un nuovo foglio "NomePaziente" per l'inserimento dei nuovi dati.

Che cosa ne pensate?

Ciao

P.s. per Darix, per non ricreare un foglio simile al tuo sarebbe opportuno che inviassi direttamente il file sostituendo dati sensibili con dati fittizi e volendo anche in MP.
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: MACRO richiamo dati se verificata condizione

Postdi darix » 15/11/09 15:28

Salve

Non credo che avere un foglio per ogni paziente sia opportuno sia per comodità di lettura (si tratta di un centinaio di pazienti) sia per la possibilità di creare nel foglio archivio tabelle pivot per una rappresentazione sintetica e grafica di alcune tipologie di parametri.

Cmq ti posto il link del file senza nominativi fittizi: http://www.megaupload.com/?d=QUBVBG4B

grazie mille

Dario
darix
Newbie
 
Post: 6
Iscritto il: 13/11/09 11:02

Re: MACRO richiamo dati se verificata condizione

Postdi Flash30005 » 15/11/09 20:54

Purtroppo il server host mi dice che il file e temporaneamente non disponibile

Per quanto riguarda i 100 (o oltre) pazienti non è un grosso problema per excel (premesso che con Access sarebbe tutto molto diverso) e per la lettura basterebbe selezionare dalla maschera un paziente con casella elenco per avere visibile solo il suo foglio (tutti gli altri resi invisibili da una macro).
Per quanto riguarda la tabella di pivot si potrebbe selezionare, sempre dalla maschera, la tipologia e avere un foglio (di output) che "raccolga" quei dati dai vari fogli e, con questi dati, fare (o far fare da una macro) qualsiasi grafico di tuo interesse.
E' chiaro, però, che non vorrei stravolgere delle abitudini che comportano, al primo impatto, disorientamento per l'utente ma appena avrò tuo file vedrò cosa si potrà fare e te lo invierò con "qualche" modifica poi deciderai sul da farsi

Ciao


Edit: ore 21:05
P.s. Ho scaricato il file ma speravo ci fossero dei dati "reali" all'interno escludendo nomi e n. di telefono invece i fogli sono completamente vuoti :roll: . Inserirò qualcosa a caso, speriamo bene!
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: MACRO richiamo dati se verificata condizione

Postdi Anthony47 » 16/11/09 00:41

Per Darix: la dichiarazione di variabili e' opzionale; se decidi di farla userai Dim I as Integer in testa al codice (se hai meno di 32000 righe, oppure as Long).
La non dichiarazione ha come effetto l' inizializzazione delle variabili come "variant", cioe' predisposte a ricevere qualsiasi tipo di dato; il che provoca un rallentamento dell' esecuzione della macro e un uso eccessivo (rispetto al bisogno) di memoria; la cosa non mi preoccupa se parliamo di millisecondi o di 200 byte come in casi come questo.
Io definisco le variabili sempre nelle macro di una certa complessita', magari insieme alla definizione Option Explicit, che genera errore di compilazione in caso di variabili non definite (che spesso sono il frutto di errori di battitura).

Fai sapere dove arrivi con le prove.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: MACRO richiamo dati se verificata condizione

Postdi darix » 17/11/09 09:17

Salve,
purtroppo il problema continua a sussistere nella indicizzazione...anche con i consigli datimi da Anthony rilevo sempre un errore in fase di debug di tipo '1004'

vi posto il codice usato che con il file excel dovrebbe costituire un quadro completo per la risoluzione del mio problema.

Codice: Seleziona tutto
Sub CopiaDati()
For Ri = Sheets("Archivio").Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Sheets("Archivio").Cells(I, 3).Value = Sheets("Maschera Dati").Range("C8").Value Then
Application.ScreenUpdating = False
       Sheets("Archivio").Select
    Range("A" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Archivio").Select
    Range("C" & Ri & ":I" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C8:C14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("J" & Ri & ":K" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C16:C17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("L" & Ri & ":N" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C22:C24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("P" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("O" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("D24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("Q" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("D25").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("R" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C30").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("S" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("E30").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("T" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("U" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C32").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("V" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("E32").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("W" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C33").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("X" & Ri & "").Select
    Selection.Copy
      Sheets("Maschera dati").Select
    Range("E33").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("Z" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C36").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("Y" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C34").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AA" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C37").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AB" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("E37").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AC" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C38").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("AD" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("E38").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AE" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C41").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AG" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C42").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("AH" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("E42").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("AF" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("E41").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AI" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C43").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AJ" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C46").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AK" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("E46").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("AL" & Ri & ":AN" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C47:C49").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("AO" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C52").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AP" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("E52").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AQ" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C53").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AR" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("E53").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AS" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("G53").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("AT" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C54").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AU" & Ri & "").Select
    Selection.Copy
      Sheets("Maschera dati").Select
    Range("C55").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("AV" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("E55").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("AW" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C56").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("AX" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("D56").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("AY" & Ri & ":BA" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C57:C59").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("BB" & Ri & ":BN" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C78:C90").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("BO" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C92").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("BP" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C93").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("BQ" & Ri & ":BT" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C95:C98").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("BU" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("E98").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("BV" & Ri & ":CE" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C103:C112").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("CF" & Ri & ":CJ" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C117:C121").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("CK" & Ri & ":CS" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C123:C131").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("CT" & Ri & ":CU" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C133:C134").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("CV" & Ri & ":CW" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C136:C137").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("CX" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C152").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("CY" & Ri & ":CZ" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("D155:E155").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("DA" & Ri & ":DB" & Ri & "").Select
    Sheets("Maschera dati").Select
    Range("D156:E156").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Archivio").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
     Range("DC" & Ri & ":DD" & Ri & "").Select
     Selection.Copy
   Sheets("Maschera dati").Select
    Range("D157:E157").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
   
     Sheets("Archivio").Select
    Range("DE" & Ri & ":DF" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("D158:E158").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("DG" & Ri & ":DH" & Ri & "").Select
    Selection.Copy
      Sheets("Maschera dati").Select
    Range("D159:E159").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("DI" & Ri & ":DJ" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("D160:E160").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
    Sheets("Archivio").Select
    Range("DK" & Ri & ":DL" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("D161:E161").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("DM" & Ri & ":DN" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("D162:E162").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("DO" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C164").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("DP" & Ri & ":EC" & Ri & "").Select
    Selection.Copy
     Sheets("Maschera dati").Select
    Range("C168:C181").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   
    Application.CutCopyMode = False
     Sheets("Archivio").Select
    Range("ED" & Ri & ":EX" & Ri & "").Select
    Selection.Copy
    Sheets("Maschera dati").Select
    Range("C188:C208").Select
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Sheets("Maschera dati").Select
    ActiveWindow.ScrollRow = 1
   
    Sheets("Archivio").Select
    Range("A1").Calculate
    ActiveWindow.ScrollColumn = 1
 Selection.ClearContents
Sheets("Maschera dati").Select
Range("C3").Select

Exit Sub
End If
Next Ri
Application.ScreenUpdating = True

    MsgBox "Richiamo record completato", vbInformation, "Avviso"
End Sub

Grazie mille per la disponibilità di tutti

Darix
darix
Newbie
 
Post: 6
Iscritto il: 13/11/09 11:02

Re: MACRO richiamo dati se verificata condizione

Postdi Anthony47 » 17/11/09 16:17

purtroppo il problema continua a sussistere nella indicizzazione...
Perdona, quale problema?
Poi, quando hai l' errore nell' esecuzione della macro, andando in debug quale istruzione risulta evidenziata?

Ma tu, con le istruzioni Range("C" & Ri & ":I" & Ri & "").Select / Copy + Range("C8:C14").Select /Paste conti di copiare le 7 celle in orizzontale in 7 celle in verticale? Guarda che non ti funzionera'... Se hai messo i dati nella form in verticale e nello storico in orizzontale puoi muoverli con un ciclo For /Next, un ciclo per ogni blocco di dati contigui (so che i piu' bravi lo farebbero con una unica "move" parametrizzata alimentata da un array contenente l' indirizzo di destinazione; se ne hai voglia potrai farlo dopo che hai una soluzione funzionante in modo convenzionale).
Il codice che hai e' facilissimo da seguire in "debug": metti un break sulla riga Application.ScreenUpdating = False (cursore sull' istruzione, F9; idem per togliere il break), poi lancia la macro: si fermera' quando ha trovato nello storico il valore che cerchi; a questo punto puoi eseguire una istruzione alla volta premendo F8, cosi' vedi che cosa ti succede nel foglio excel ed e' anche facile capire cosa modificare. Il lato negativo e' che non e' ottimizzato; ad esempio le istruzioni
Sheets("Archivio").Select
Range("A" & Ri & "").Select
Selection.Copy
Sheets("Maschera dati").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Archivio").Select

Possono essere sostituite da
Sheets("Archivio").Select
Range("A" & Ri ).Copy Destination:= Sheets("Maschera dati").Range("C3")
Che pero' e' meno facile da debuggare
(ho usato il paste standard e non il PasteSpecial perche' credo che i valori in Storico siano gia' dei valori, non delle formule)

Ma l' ottimizzazione, se e' realmente un problema, sara' fatta dopo che la macro ti funziona.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: MACRO richiamo dati se verificata condizione

Postdi darix » 17/11/09 19:09

Grazie Anthony, tenterò e farò sapere
darix
Newbie
 
Post: 6
Iscritto il: 13/11/09 11:02

Re: MACRO richiamo dati se verificata condizione

Postdi Anthony47 » 18/11/09 02:18

Io mi sono fermato alle linee guida perche' mi pare che sai cosa fare; se invece ..mi hai portato fuori strada allora possiamo scendere a maggiori dettagli.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: MACRO richiamo dati se verificata condizione

Postdi darix » 18/11/09 09:42

Sinceramente credevo anch'io di sapere cosa fare...ma il magico mondo delle macro in VBA mni si è spiegato solo da poco tempo e non ho grande esperienza...Documentandomi sono riuscito a risolvere i problemi relativi alle funzionalità più semplici, ma mi sto perdendo con la esecuzione indicizzata dell'operazione di copia -incolla se è verificata una o più condizioni (perchè può capitare che ci siano più pazienti con lo stesso cognome , ma nome diverso)

in ogni caso girovagando nel forum ho trovato una di quelle soluzioni eleganti che fanno ricorso agli array cui anche tu, caro Anthony hai accennato e ho cercato di personallizarla:
Codice: Seleziona tutto
Sub CopiaDati()
Dim Rng As Range
Dim SH1 As Worksheet
Dim SH2 As Worksheet
Dim WB As Workbook
Dim arr As Variant
Dim i As Long

Set WB = ActiveWorkbook
Set SH1 = WB.Sheets("Maschera Dati")
Set SH2 = WB.Sheets("Archivio")

Set Rng = SH2.Range("C6:EW6")
arr = Array("C8", "C9", "C10", "C11", "C12", "C13", "C14", "C16", "C17", "C22", "C23", "C24", "C25", "D24", "D25", "C30", "C31", "C32", "C33", _
"C34", "E30", "E32", "E33", "C36", "C38", "E37", "E38", "C41", "C42", "C43", "E41", "E42", "C46", "C47", "C48", "C49", "E46", "C52", "C53", _
"C54", "C55", "C56", "C57", "C58", "C59", "D56", "E52", "E53", "G53", "C78", "C90", "C92", "C93", "C95", "C96", "C97", "C98", "E98", "C103", _
"C104", "C105", "C106", "C107", "C108", "C109", "C110", "C111", "C112", "C117", "C118", "C119", "C120", "C121", "C123", "C124", "C125", _
"C126", "C127", "C128", "C129", "C130", "C131", "C133", "C134", "C136", "C137", "C152", "D155", "E155", "D156", "E156", "D157", "E157", _
"D158", "E158", "D159", "E159", "D160", "E160", "D161", "E161", "D162", "E162", "C164", "C168", "C169", "C170", "C171", "C172", "C173", "C174", _
"C175", "C176", "C177", "C178", "C179", "C180", "C181", "C188", "C189", "C190", "C191", "C192", "C193", "C194", "C195", "C196", "C197", "C198", _
"C199", "C200", "C201", "C202", "C203", "C204", "C205", "C206", "C207", "C208")
If Sheets("Archivio").Cells(i, 3).Value = Sheets("Maschera Dati").Range("C8").Value Then
For i = 1 To Rng1.Cells.Count
SH1.Range(arr(i - 1)).Value = Rng.Cells(i).Value
    MsgBox "Richiamo record completato", vbInformation, "Avviso"
Next
End If
End Sub


ma mi compare nel debug "errore 1004" alla riga
Codice: Seleziona tutto
If Sheets("Archivio").Cells(i, 3).Value = Sheets("Maschera Dati").Range("C8").Value Then


la mia esperienza con il vba si limita a questo tentativo di applicazione...in genere mi bastava il registratore di macro e quindi sono un pò in difficoltà.
P.S. Non so se possa influenzare la corretta scrittura della macro ma il file xls postato in precedenza contiene un folgio nascosto "Parametri" per la selezione guidata dei campi in azzurrino nel folgio "Maschera Dati"

Grazie mille escusate il disturbo

Dario
darix
Newbie
 
Post: 6
Iscritto il: 13/11/09 11:02

Re: MACRO richiamo dati se verificata condizione

Postdi Flash30005 » 18/11/09 10:54

Prova a vedere se una macro così ti può essere utile
Codice: Seleziona tutto
Sub FoglioPaziente()
'----------- da qui inzia e toglie tutti i fogli ad esclusione di Maschera, Archivio e Parametri
NomeF = ""
For Each ws In Worksheets
If Worksheets(ws.Name).Name = "Maschera dati" Or Worksheets(ws.Name).Name = "Archivio" Or Worksheets(ws.Name).Name = "Parametri" Then GoTo salta
    Application.DisplayAlerts = False
    Worksheets(ws.Name).Delete
    Application.DisplayAlerts = True
salta:
Next ws
'----------- qui finisce codice chee toglie tutti i fogli ad esclusione ....

NomeF = Sheets("Maschera dati").Range("C8").Value & "." & Sheets("Maschera dati").Range("C9").Value
    Sheets("Archivio").Select
    Sheets("Archivio").Copy After:=Sheets(3)
    Sheets("Archivio (2)").Name = NomeF
    UR = Worksheets(NomeF).Range("A" & Rows.Count).End(xlUp).Row
    For RR = UR To 6 Step -1
        If Range("C" & RR).Value & "." & Range("D" & RR).Value <> NomeF Then Rows(RR & ":" & RR).Delete Shift:=xlUp
    Next
    Range("A1").Select
End Sub


La parte di macro che elimina i fogli la puoi inserire anche all'inizio delle tue macro per eliminare, se occorre, il foglio del paziente.

Fai sapere
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: MACRO richiamo dati se verificata condizione

Postdi pietrol » 18/11/09 15:19

Anche oggi, come spesso mi accade qui, ho imparato una cosa nuova di cui nemmeno immaginavo l'esistenza.
Grazie a Anthony, a Flash e a tutti coloro che partecipano a questo forum.

ciao
pietrol
il lupo ululà, il castello ululì
pietrol
Utente Senior
 
Post: 270
Iscritto il: 07/01/09 14:34

Re: MACRO richiamo dati se verificata condizione

Postdi Flash30005 » 18/11/09 16:12

pietrol ha scritto:Anche oggi, come spesso mi accade qui, ho imparato una cosa nuova di cui nemmeno immaginavo l'esistenza.


Che accada a me una cosa del genere è abbastanza normale :lol:
(penso che non si finisca mai di imparare)

Ma sarei curioso di sapere cosa ha suscitato tanto interesse in te, Pietrol
(perché ti vedo spesso disponibile a dare ottime soluzioni agli utenti in difficoltà, soluzioni che evidenziano una preparazione non indifferente)

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: MACRO richiamo dati se verificata condizione

Postdi pietrol » 18/11/09 19:00

Ciao Flash
non una sola cosa in effetti, ma due:
1) il trucco proposto da Anthony per la visualizzazioni dei flag di spunta, bellissimo
(io però aggiungerei una postilla: usando invece il formato ["þ";;"o"] ,senza parentesi, diventa possibile utilizzare formule che restituiscono VERO/FALSO, o meglio 0/1, tipo
=--(A1>4)
ottenendo automaticamente a video il flag spuntato o meno, non vedo l'ora di applicarle da qualche parte.
2) il tuo suggerimento per l'utilizzo di fogli "temporanei" ed eliminabili a fine utilizzo, al posto di complicate routine di pulizia, quanto codice risparmiato!

La mente vacilla al solo pensiero di quante volte avrei già potuto usarle.

ciao
pietrol
il lupo ululà, il castello ululì
pietrol
Utente Senior
 
Post: 270
Iscritto il: 07/01/09 14:34

Re: MACRO richiamo dati se verificata condizione

Postdi Anthony47 » 18/11/09 20:17

Pietrol, per favore non farci arrossire :oops: , e scrivi invece piu' spesso :lol: ...
Per Flash:
PERO' trovo pericoloso suggerire una macro che cancella tutti i fogli esistenti eccetto qualcuno; meglio cancellare solo i fogli di cui si conosce l' esistenza e la loro non necessita'.
La macro, mi sembra che produce una copia dell' archivio "filtrata" con Cognome&Nome; un dato intermedio da cui si dovrebbe attingere poi per la ricerca e il popolamento della Maschera; ma con questa logica creare una copia dell' archivio non serve, perche' basterebbe cercare la prima riga che ha quel Nome/Cognome e trasferirla in Maschera.

Io pero' propenderei per una strada leggermente diversa, partendo da presupposto che fatto il controllo dei Nomi poi ci saranno gli omonimi con data di nascita diversa, e poi uno non fa mica solo lo stesso tipo di esame...

Ma prima facciamo un passo indietro, e mi rivolgo a Darix.
L' errore occorre perche' la variabile I non e' inizializzata, quindi in quel momento provi ad accedere alla cella C0.

In realta' manca nella macro tutto il ciclo per scorrere all' indietro l' elenco e verificare il cognome: avevi ustao For Ri = Sheets("Archivio").Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 / Next Ri, che devi inserire attorno alle tue istruzioni (dopo il caricamento dell' array); questo significa anche che nell' istruzione ora in errore dovrai usere "Ri" e non "I" (variabile che e' usata nel ciclo di trasferimento dati).

Ci sono poi alcuni errori, che ho corretto in questa versione della tua macro:

Codice: Seleziona tutto
Sub CopiaDati()
Dim Rng As Range
Dim SH1 As Worksheet
Dim SH2 As Worksheet
Dim WB As Workbook
Dim Arr As Variant
Dim I As Long, Ri As Long

Set WB = ActiveWorkbook
Set SH1 = WB.Sheets("Maschera Dati")
Set SH2 = WB.Sheets("Archivio")

Set Rng = SH2.Range("C6:EW6")   'Questa e' inutile
Arr = Array("C8", "C9", "C10", "C11", "C12", "C13", "C14", "C16", "C17", "C22", "C23", "C24", "C25", "D24", "D25", "C30", "C31", "C32", "C33", _
"C34", "E30", "E32", "E33", "C36", "C38", "E37", "E38", "C41", "C42", "C43", "E41", "E42", "C46", "C47", "C48", "C49", "E46", "C52", "C53", _
"C54", "C55", "C56", "C57", "C58", "C59", "D56", "E52", "E53", "G53", "C78", "C90", "C92", "C93", "C95", "C96", "C97", "C98", "E98", "C103", _
"C104", "C105", "C106", "C107", "C108", "C109", "C110", "C111", "C112", "C117", "C118", "C119", "C120", "C121", "C123", "C124", "C125", _
"C126", "C127", "C128", "C129", "C130", "C131", "C133", "C134", "C136", "C137", "C152", "D155", "E155", "D156", "E156", "D157", "E157", _
"D158", "E158", "D159", "E159", "D160", "E160", "D161", "E161", "D162", "E162", "C164", "C168", "C169", "C170", "C171", "C172", "C173", "C174", _
"C175", "C176", "C177", "C178", "C179", "C180", "C181", "C188", "C189", "C190", "C191", "C192", "C193", "C194", "C195", "C196", "C197", "C198", _
"C199", "C200", "C201", "C202", "C203", "C204", "C205", "C206", "C207", "C208")

For Ri = Sheets("Archivio").Cells(Rows.Count, 1).End(xlUp).Row To 5 Step -1  '**1
If Sheets("Archivio").Cells(Ri, 3).Value = Sheets("Maschera Dati").Range("C8").Value Then '**2
For I = 0 To UBound(Arr)   '**3
SH1.Range(Arr(I)).Value = SH2.Cells(Ri, I + 3).Value  '**4
Next I   '**5
    MsgBox "Richiamo record completato", vbInformation, "Avviso"  '**6
Exit Sub               '**7
End If
Next Ri    '**1
MsgBox ("Non ci sono record con questa chiave di ricerca: " & vbCrLf & _
        Sheets("Maschera Dati").Range("C8").Value)  '**8
End Sub

Le note:
**1: questo loop mancava ed e' stato inserito
**2: avevi usato come termine di paragone Sheets("Archivio").Cells(i, 3).Value, ma l' indice giusto e' Ri
**3: da 0 perche' 0 e' la base, a "to UBound(Arr)" significa "fino all' elemento piu' alto nell' array; ovviamente dovrebbero esserci in array tanti valori quante le celle da caricare: io ho contato 139 elementi in array, non so se il numero e' giusto perche' non so dove arriva l' archivio (e se va da col C a EW allora sono 151 celle, e non quadrerebbe).
**4: modificato il secondo termine
**5: e' presente un altro ciclo For /Next, meglio essere espliciti
**6: ho portato fuori dal ciclo di trasferimento questo messaggio, altrimenti ti saresti innervosito con 100-150 "Ok"
**7: questo mancava, e serve a uscire trovato il primo confronto
**8: questo l' ho aggiunto

Attenzione, questa macro funziona (probabilmente), ma non e' quella che cerchi, visto che (me l' aspettavo) non basta confrontare il cognome. Un primo approccio e' quello usato da Flash, che confronta in concatenamento tra Cognome e Nome.

Poiche' temo che Cognome+Nome non basta, io propongo:
-ti fai un foglio "Intermedio", dove una macro1 riporta tutti i record di Storico che corrispondono al Cognome immesso; ovviamente non riporterai le 100 e passa celle dell' Archivio, ma solo quelle N che consentono di qualificare l' esame (invento: Cognome, Nome, data di nascita, data esame, tipo di esame, ...), ma in prima colonna metterai l' indice della riga su Archivio (corrisponde al valore di Ri).
-ordini i dati per Nome, data di esame, tipo di esame
-usi questo elenco per scegliere quale esame ricopiare nella Maschera dati, tramite selezione riga e una macro2

La macro1 e' similissima a quella che ti ho dato prima, con la variante che non si esce alla prima riga trovata, userai un array con le colonne che vuoi riportare da Archivio su Intermedio, e' preceduta dall' azzeramento delle righe da 2 a 1000 (in riga 1 avrai messo le intestazioni) ed e' seguita dall' ordinamento dei dati presenti. Il codice per queste due operazioni lo ottieni tramite Registra nuova macro.
Potrebbe essere anche quella usata da Flash, ma il Delete(row)+Shift(xlUp) non e' proprio velocissimo e in questo metodo (visto che l' obiettivo non e' creare un duplicato delle righe di Archivio, ma una sintesi), non sarebbe nemmeno sufficiente.

La macro2 e' un sotto-insieme della macro "CopiaDati", salvo che Ri lo hai gia' dalla colonna A della riga selezionata su Intermedio, quindi procedi subito al trasferimento senza la ricerca.

Spero che trovi qualcosa di utile, comunque fai sapere come procedi e dove arrivi.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "MACRO richiamo dati se verificata condizione":


Chi c’è in linea

Visitano il forum: Nessuno e 58 ospiti