Condividi:        

[VBA] Piccola modifica

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

[VBA] Piccola modifica

Postdi ramset64 » 20/02/09 13:18

Private Sub AggiornaTutti()
Dim CopySh As String, CopiedSh As String, NextName As String, StWB As String
Dim FlEx As Integer
StWB = ThisWorkbook.Name
ChDrive Range("Drive") 'per cambiare drive
ChDir Range("Path") 'path per i file da aprire

'
I = 0
Do
Windows(StWB).Activate
NextName = Sheets("Foglio1").Range("A5").Offset(I, 0).Value
If NextName = "" Then GoTo Exita
Workbooks.Open Filename:=NextName
OWb = ActiveWorkbook.Name
'Qui hai aperto il primo file del tuo elenco
CMacro = "'" & OWb & "'!Foglio1.CmdBtnx_Click" '<<< Cioe' ! +il nome della macro
Application.Run (CMacro)
'
Workbooks(OWb).Close SaveChanges:=True
'
I = I + 1
Loop
Exita:
End Sub

Questa macro mi aggiorna tutti i file contenuti nella colonna A (dalla riga 5 in giù), se volessi invece aggiornare solo un gruppo di file (ad esempio quelli selezionati) come dovrei modificare la macro?

Grazie
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Sponsor
 

Re: [VBA] Piccola modifica

Postdi Anthony47 » 21/02/09 01:39

Ti do' le guideline, perche' non riesco a impostare e collaudare stasera.

-Invece di I=0 usi I=selection.range("A1").row per calcolare la prima riga di selezione
-subito dopo (prima di Do) calcoli la fine con IEnd=I+selection.rows.count
-invece di NextName = Sheets("Foglio1").Range("A5").Offset(I, 0).Value userai
NextName = Sheets("Foglio1").Range("A" & I).Value
-invece di If NextName = "" Then GoTo Exita userai
If I>=IEnd Goto Exita

Ciao, fai sapere se il collage riesce; mi raccomando le copie di backup PRIMA di tutto...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [VBA] Piccola modifica

Postdi ramset64 » 21/02/09 11:58

Collage riuscito, tutto ok. Grazie
Posso chiederti ancora una piccola modifica su un'altra macro?
Nel file allegato ci sono 2 codici (che ricorderai credo).
Nel primo codice vorrei che aggiungesse una parola (es. "calcolo") nella prima colonna disponibile del foglio 2 (quindi dopo DayMin).
Nel secondo codice vorrei che aggiungesse un calcolo con la funzione fomulalocal (che poi aggiungerò io) sempre nella prima colonna disponibile e quindi in quella sopradenominata "calcolo".

Se ti è possibile, grazie,
ciao
Allegati

[L’estensione rar è stata disattivata e non puó essere visualizzata.]

ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [VBA] Piccola modifica

Postdi ramset64 » 21/02/09 14:53

umh.... il calcolo di cui sopra pensavo fosse più semplice ed invece....

Dunque supponendo che l'ultimo close sia sulla colonna AD del foglio2, che il maxday sia sulla colonna AE ed il MinDay sulla colonna AF sempre del foglio2 (quindi come nell'esempio del file allegato), il calcolo da inserire alla riga 3 sarebbe:

=MAX(100*((AE3/AF3)-1),ASS(100*((AD3/AF2)-1)),ASS(100*((AD3/AE2)-1)))
e cosi vi in basso.

Il problema però è che io NON so dove si trovino l'ultimo close il maxday e minday perchè ogni foglio ha TimeFrame diverso e quindi utilizza più o meno colonne.

Esiste un modo per adattare automaticamente quella formula in base alla prima colonna vuota del foglio2?

Grazie, ciao
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [VBA] Piccola modifica

Postdi Anthony47 » 21/02/09 17:57

Prova inserendo nella macro PrimoIncolonnamentoDati le righe righe marcate "<<< ADD" o "<<< MODIF" (le altre istruzioni sono riportate per identificare la posizione).
Primo blocco (1 riga aggiunta, 1 modificata)
Codice: Seleziona tutto
    Sheets(DSh).Range("B1").Offset(0, i + 1).Value = "DayMin"
    Sheets(DSh).Range("B1").Offset(0, i + 2).Value = "Calcolo"       '<< ADD
    Sheets(DSh).Range("A2", Sheets(DSh).Cells(Rows.Count, i + 5)).Clear  '<<< MODIF

Secondo blocco (2 righe aggiunte)
Codice: Seleziona tutto
    If CMax > 0 Then Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, i + 2).Value = CMax
    If CMin > 0 Then Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, i + 3).Value = CMin
    If CMax > 0 Then Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, i + 4).FormulaR1C1 = _
            "=MAX(100*((R[1]C[-2]/R[1]C[-1])-1),ABS(100*((R[1]C[-3]/RC[-1])-1)),ABS(100*((R[1]C[-3]/RC[-2])-1)))"    '<< ADD 2 RIGHE


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

Re: [VBA] Piccola modifica

Postdi ramset64 » 21/02/09 18:33

Grazie Antony, funziona ma...
il calcolo che riporta nella riga3 dovrebbe andare nella riga 2 e cosi via.... questo però porterà un errore nel primo calcolo (visto che fa riferimento alla riga1 dove non ci sono numeri), se fosse possibile fargli lasciare vuota la cella sarebbe di grande aiuto.

poi sarebbe molto utile che inserisse nella colonna "calcolo" solo il risultato ottenuto e non la formula perchè cosi in fase di aggiornamento dei dati mi rallenta da morire.


P.s. Credevo fosse necessario modificare anche la seconda macro !!! :)

Grazie mille!
Ciao
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [VBA] Piccola modifica

Postdi Anthony47 » 22/02/09 20:56

Le piccole modifiche mi spaventano sempre...
il calcolo che riporta nella riga3 dovrebbe andare nella riga 2 e cosi via.
In effetti lo avevi gia' detto.

sarebbe molto utile che inserisse nella colonna "calcolo" solo il risultato ottenuto e non la formula
Si puo' fare.

Sostituisci questa:
If CMax > 0 Then Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, i + 4).FormulaR1C1 = _
"=MAX(100*((R[1]C[-2]/R[1]C[-1])-1),ABS(100*((R[1]C[-3]/RC[-1])-1)),ABS(100*((R[1]C[-3]/RC[-2])-1)))" '<< ADD 2 RIGHE
con queste:
Codice: Seleziona tutto
If CMax > 0 And Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Row > 2 Then Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, i + 4).FormulaR1C1 = _
        "=MAX(100*((RC[-2]/RC[-1])-1),ABS(100*((RC[-3]/R[-1]C[-1])-1)),ABS(100*((RC[-3]/R[-1]C[-2])-1)))"
Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, i + 4).Value = Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, i + 4).Value

Sarebbe utile inserire queste 2 e le due precedenti in una With Sheets(DSh).Cells(Rows.Count, 1).End(xlUp) ma oramai e' piu' semplice aggiungere che non modificare; va a scapito della compattezza del codice.

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


Torna a Applicazioni Office Windows


Topic correlati a "[VBA] Piccola modifica":


Chi c’è in linea

Visitano il forum: Nessuno e 35 ospiti