Funzione loop

Hai un problema con Excel?

Nuova discussione

Funzione loop
di Kubrick (utente non iscritto) data: 27/05/2010
Non riesco a fargli fare un loop ogni 3 secondi chi sa rispondermi

Public SchTime
Function Cerca_Cella_Vuota()
'identifica la prima casella vuota dopo n nella colonna scelta


UltimaRiga = Range("A65356").End(xlUp).Row


Cerca_Cella_Vuota = UltimaRiga + 1


End Function
Private Sub Copia_Click()
Do

SchTime = Now + TimeValue("00:00:03") 'imposti il timer ovvero ongi quanto vuoi il refresh

  
    ActiveWindow.SmallScroll Down:=-24
    Range("A1").Select
    Selection.Delete Shift:=xlUp
    Range("S1971").Select
    Selection.Copy
    Range("A2000").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-30
    Range("M1971:S1971").Select
    Application.CutCopyMode = False
    Selection.Cut
    ActiveWindow.SmallScroll Down:=19
    Range("M2007").Select
    Selection.Insert Shift:=xlDown
Exit Do
Loop




End Sub

Private Sub Copia_Click_Stop_Click()




End Sub

di Locate (utente non iscritto) data: 27/05/2010
Ciao
perche' non usi la funzione timer() vedi help di vba al posto di timervalue()
ti inserisco la pagina di help relativa a questa funzione la devi adattare al tuo scopo
ciao da locate

Esempio di funzione Timer
In questo esempio la funzione Timer viene utilizzata per interrompere temporaneamente l'applicazione. Viene inoltre utilizzata la funzione DoEvents per passare il controllo dall'applicazione ad altri processi durante la pausa.

Dim PauseTime, Start, Finish, TotalTime
If (MsgBox("Scegliere Sì per interrompere l'applicazione per 5 secondi", 4)) = vbYes Then
    PauseTime = 5    ' Imposta la durata.
    Start = Timer    ' Imposta l'ora di inizio.
    Do While Timer < Start + PauseTime
        DoEvents        ' Passa il controllo ad altri processi.
    Loop
    Finish = Timer    ' Imposta l'ora di fine della pausa.
    TotalTime = Finish - Start    ' Calcola il tempo totale.
    MsgBox "Interruzione di " & TotalTime & " secondi"
Else
    End
End If

di Big ronnie (utente non iscritto) data: 28/05/2010
Ciao kubrik,

se tu scrivi exit do prima di loop esci dal ciclo e quindi non ottieni l'aggiornamento.

ciao big
di Kubrick (utente non iscritto) data: 29/05/2010
Il problema l'ho risolto di fortuna adesso ne ho un altro che poi vi postero'

di Kubrick (utente non iscritto) data: 29/05/2010
Il problema precedente e' stato risolto , adesso c'e' l'ultimo scoglio e vi spiego di cosa si tratta :
guardando le istruzioni vedrete che :
es : la casella s1971 contiene una funzione =se(e(m1971>=r1971; m1971<=q1971);o1971;"")
il problema e' che il contenuto di questa casella va a finire in a2000 non sotto forma di numero come vorrei
ma di funzione e quindi non mi compare il numero.
per essere piu chiaro se io faccio un copia incolla (normale ) non mi incolla il valore ma la funzione , se invece faccio un copia incolla speciale e metto valore allora lo fa correttamente.
per adattare le istruzione di visualbasic facendomi incollare in a2000 il valore cosa devo aggiungere

Public SchTime
Function Cerca_Cella_Vuota()
'identifica la prima casella vuota dopo n nella colonna scelta


UltimaRiga = Range("A65356").End(xlUp).Row


Cerca_Cella_Vuota = UltimaRiga + 1


End Function
Private Sub Copia_Click()
Do

SchTime = Now + TimeValue("00:15:00") 'imposti il timer ovvero ongi quanto vuoi il refresh

  
    ActiveWindow.SmallScroll Down:=-24
    Range("A1").Select
    Selection.Delete Shift:=xlUp
    Range("S1971").Select
    Selection.Copy
    Range("A2000").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-30
    Range("M1971:S1971").Select
    Application.CutCopyMode = False
    Selection.Cut
    ActiveWindow.SmallScroll Down:=19
    Range("M2007").Select
    Selection.Insert Shift:=xlDown
    
Exit Do
Loop

Application.OnTime SchTime, "Foglio3.Copia_Click"



End Sub

Private Sub Copia_Click_Stop_Click()

Application.OnTime EarliestTime:=SchTime, Procedure:="Foglio3.Copia_Click", Schedule:=False



End Sub

di Ricky53 (utente non iscritto) data: 30/05/2010
Ciao,
devi utilizzare il copia, incolla speciale, valori.
fai l'operazione con il registratore di macro ed avrai il codice.

attenzione:
nel tuo codice c'è l'istruzione "exit do" che non capisco perchè c'è.
con quella istruzione non viene eseguito il ciclo ma esce subito dopo aver eseguito le istruzioni di copia ed incolla.
a questo punto mi chiedo anche:
il ciclo a cosa ti serve.

ciao da ricky53
di Kubrick (utente non iscritto) data: 31/05/2010
Ok ci provo poi ti faccio sapere .
il loop funziona , serve per aggiornare a2000 ogni 15 minuti , dai poi ti faccio sapere.
nel caso posto un nuovo allegato a lavoro fatto nel caso sorgano problemi
di Ricky53 (utente non iscritto) data: 31/05/2010
Ciao,

è un modo un po' particolare di gestire il "trascorrere del tempo" tra loop ed "exit do" comunque funzionando ...

se quanto ti ho inviato privatamente funziona inseriscilo nel forum.

ciao da ricky53

di Kubrick (utente non iscritto) data: 02/06/2010
Programma ultimato con le ultime modifiche da ricky53

Public SchTime
Function Cerca_Cella_Vuota()
'identifica la prima casella vuota dopo n nella colonna scelta


UltimaRiga = Range("A65356").End(xlUp).Row


Cerca_Cella_Vuota = UltimaRiga + 1


End Function
Private Sub Copia_Click()
Do

SchTime = Now + TimeValue("00:15:00") 'imposti il timer ovvero ongi quanto vuoi il refresh

  
    Application.ScreenUpdating = False ' <<<-----  Istruzione inserita
    Foglio_Attivo = ActiveSheet.Name '<<<-----  Istruzione inserita
    Foglio3.Select ' <<<-----  Istruzione inserita
    Range("A2:A2000").Select
    Selection.Copy
    Range("A1").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    ActiveWindow.SmallScroll Down:=-8
    Range("S1971").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=10
    Range("A2000").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-10
    Range("M1971:S1971").Select
    Application.CutCopyMode = False
    Selection.Cut
    ActiveWindow.SmallScroll Down:=20
    Range("M2007").Select
    Selection.Insert Shift:=xlDown
    Sheets(Foglio_Attivo).Select ' <<<-----  Istruzione inserita
    Application.ScreenUpdating = True ' <<<-----  Istruzione inserita
Exit Do
Loop

Application.OnTime SchTime, "Foglio3.Copia_Click"



End Sub

Private Sub Copia_Click_Stop_Click()

Application.OnTime EarliestTime:=SchTime, Procedure:="Foglio3.Copia_Click", Schedule:=False



End Sub

Vuoi Approfondire?