Velocizzare un codice

Hai un problema con Excel?

Nuova discussione

Velocizzare un codice
di trump61 data: 17/04/2014 01:19:47
Ciao a tutti, il codice scritto sotto fa il suo sporco lavoro ma è un po troppo lento, c'è qualcuno che mi può suggerire come accelerarlo un po'.
Grazie

 Sub Uni() 'codice per visualizzare il turno settimanale
 Dim r As Long, c As Long, w As Long, d As Long, q As Long
 Dim Y As Object
r = Worksheets("Turno Base").Cells(2, 10).Value
q = r + 9
c = 4
   For w = 4 To 36
    For d = 3 To 9
    Set Y = Worksheets("Turno Base").Cells(q, c)
    Worksheets("TurnoSquadre").Cells(w, d).Value = Y.Value
    If c = 10 Then c = 4 Else c = c + 1
    Next
    q = q + 1
   Next
   Worksheets("TurnoSquadre").Cells(2, 1).Value = Worksheets("Turno base").Cells(2, 10).Value
   Worksheets("TurnoSquadre").Cells(2, 3).Value = Worksheets("Turno base").Cells(7, 4).Value
   Worksheets("TurnoSquadre").Cells(2, 4).Value = Worksheets("Turno base").Cells(7, 5).Value
   Worksheets("TurnoSquadre").Cells(2, 5).Value = Worksheets("Turno base").Cells(7, 6).Value
   Worksheets("TurnoSquadre").Cells(2, 6).Value = Worksheets("Turno base").Cells(7, 7).Value
   Worksheets("TurnoSquadre").Cells(2, 7).Value = Worksheets("Turno base").Cells(7, 8).Value
   Worksheets("TurnoSquadre").Cells(2, 8).Value = Worksheets("Turno base").Cells(7, 9).Value
   Worksheets("TurnoSquadre").Cells(2, 9).Value = Worksheets("Turno base").Cells(7, 10).Value
 End Sub

di lepat (utente non iscritto) data: 17/04/2014 08:14:43
allega un file di esempio e spiega l'obiettivo del codice

di Lucas87 data: 17/04/2014 08:16:16
Ciao
Prova così e segui le indicazioni...
Se non ti basta dovrai spiegare cosa vuoi ottenere. Magari c'è un metodo più rapido

Sub Uni() 'codice per visualizzare il turno settimanale
Dim c As Long, w As Long, d As Long, q As Long
Application.ScreenUpdating = False              'disattiva l'aggiornamento della schermata
q = Worksheets("Turno Base").Cells(2, 10).Value + 9     'tolgo r se non la usi non serve
c = 4
For w = 4 To 36
    For d = 3 To 9
        Worksheets("TurnoSquadre").Cells(w, d).Value = Worksheets("Turno Base").Cells(q, c).Value  'dichiari y e poi la usi una volta sola. uno spreco
        If c = 10 Then
            c = 4
        Else
            c = c + 1
    Next
    q = q + 1
Next
Worksheets("TurnoSquadre").Cells(2, 1).Value = Worksheets("Turno base").Cells(2, 10).Value       'da qui in giù usa le formule direttamente sul foglio
Worksheets("TurnoSquadre").Cells(2, 3).Value = Worksheets("Turno base").Cells(7, 4).Value
Worksheets("TurnoSquadre").Cells(2, 4).Value = Worksheets("Turno base").Cells(7, 5).Value
Worksheets("TurnoSquadre").Cells(2, 5).Value = Worksheets("Turno base").Cells(7, 6).Value
Worksheets("TurnoSquadre").Cells(2, 6).Value = Worksheets("Turno base").Cells(7, 7).Value
Worksheets("TurnoSquadre").Cells(2, 7).Value = Worksheets("Turno base").Cells(7, 8).Value
Worksheets("TurnoSquadre").Cells(2, 8).Value = Worksheets("Turno base").Cells(7, 9).Value
Worksheets("TurnoSquadre").Cells(2, 9).Value = Worksheets("Turno base").Cells(7, 10).Value
Application.ScreenUpdating = True
End Sub

di Lucas87 data: 17/04/2014 08:30:44
Altra modifica...
Ho tolto la verifica del valore di c
Viene impostata a 4 ogni volta che ricomincia il primo ciclo

Sub Uni() 'codice per visualizzare il turno settimanale
Dim c As Long, w As Long, d As Long, q As Long
Application.ScreenUpdating = False              'disattiva l'aggiornamento della schermata
q = Worksheets("Turno Base").Cells(2, 10).Value + 9     'tolgo r se non la usi non serve
For w = 4 To 36
    c = 4
    For d = 3 To 9
        Worksheets("TurnoSquadre").Cells(w, d).Value = Worksheets("Turno Base").Cells(q, c).Value  'dichiari y e poi la usi una volta sola. uno spreco
        c = c + 1
    Next
    q = q + 1
Next
Worksheets("TurnoSquadre").Cells(2, 1).Value = Worksheets("Turno base").Cells(2, 10).Value       'da qui in giù usa le formule direttamente sul foglio
Worksheets("TurnoSquadre").Cells(2, 3).Value = Worksheets("Turno base").Cells(7, 4).Value
Worksheets("TurnoSquadre").Cells(2, 4).Value = Worksheets("Turno base").Cells(7, 5).Value
Worksheets("TurnoSquadre").Cells(2, 5).Value = Worksheets("Turno base").Cells(7, 6).Value
Worksheets("TurnoSquadre").Cells(2, 6).Value = Worksheets("Turno base").Cells(7, 7).Value
Worksheets("TurnoSquadre").Cells(2, 7).Value = Worksheets("Turno base").Cells(7, 8).Value
Worksheets("TurnoSquadre").Cells(2, 8).Value = Worksheets("Turno base").Cells(7, 9).Value
Worksheets("TurnoSquadre").Cells(2, 9).Value = Worksheets("Turno base").Cells(7, 10).Value
Application.ScreenUpdating = True
End Sub

di Zer0Kelvin data: 17/04/2014 09:14:14
Ciao.
Credo che il ciclo interno sia superfluo.
Il codice che segue dovrebbe essere equivalente

Sub Uni() 'codice per visualizzare il turno settimanale
Dim w As Long, q As Long
Dim shB As Worksheet, shS As Worksheet
Application.ScreenUpdating = False
Set shB = Worksheets("Turno Base")
Set shS = Worksheets("TurnoSquadre")
q = shB.Cells(2, 10).Value + 9
For w = 4 To 36
   Range(shS.Cells(w, 3), shS.Cells(w, 9)).Value = Range(shB.Cells(q, 4), shB.Cells(q, 10)).Value
   q = q + 1
Next
shS.Cells(2, 1).Value = shB.Cells(2, 10).Value       'da qui in giù usa le formule direttamente sul foglio
shS.Cells(2, 3).Value = shB.Cells(7, 4).Value
shS.Cells(2, 4).Value = shB.Cells(7, 5).Value
shS.Cells(2, 5).Value = shB.Cells(7, 6).Value
shS.Cells(2, 6).Value = shB.Cells(7, 7).Value
shS.Cells(2, 7).Value = shB.Cells(7, 8).Value
shS.Cells(2, 8).Value = shB.Cells(7, 9).Value
shS.Cells(2, 9).Value = shB.Cells(7, 10).Value
Application.ScreenUpdating = True
End Sub

di Zer0Kelvin data: 17/04/2014 09:43:37
PS: dimenticavo di impostare a nothing gli oggetti usati
... Set shB = Nothing Set shS = Nothing Application.ScreenUpdating = True End Sub

di Zer0Kelvin data: 17/04/2014 09:52:06
Ripensandoci, forse non serve nessun ciclo

Sub Uni() 'codice per visualizzare il turno settimanale
Dim q As Long
Dim shB As Worksheet, shS As Worksheet
Application.ScreenUpdating = False
Set shB = Worksheets("Turno Base")
Set shS = Worksheets("TurnoSquadre")
q = shB.Cells(2, 10).Value + 9
Range(shS.Cells(4, 3), shS.Cells(36, 9)).Value = Range(shB.Cells(q, 4), shB.Cells(q + 32, 10)).Value
shS.Cells(2, 1).Value = shB.Cells(2, 10).Value       'da qui in giù usa le formule direttamente sul foglio
shS.Cells(2, 3).Value = shB.Cells(7, 4).Value
shS.Cells(2, 4).Value = shB.Cells(7, 5).Value
shS.Cells(2, 5).Value = shB.Cells(7, 6).Value
shS.Cells(2, 6).Value = shB.Cells(7, 7).Value
shS.Cells(2, 7).Value = shB.Cells(7, 8).Value
shS.Cells(2, 8).Value = shB.Cells(7, 9).Value
shS.Cells(2, 9).Value = shB.Cells(7, 10).Value
Set shB = Nothing
Set shS = Nothing
Application.ScreenUpdating = True
End Sub

di trump61 data: 18/04/2014 09:35:05
Ciao grazie per le risposte, non ho potuto risponderti prima perchè ho avuto problemi di lavoro.
Adesso provo e ti faccio sapere
di trump61 data: 20/04/2014 06:57:08
grazie, funziona fino al penultimo codice, ed è più veloce l'ultimo non va
di trump61 data: 20/04/2014 06:58:16
Dimenticavo la spunta
di trump61 data: 20/04/2014 07:02:33
Scusa ho sbagilato funziona anche ultimo codice

Vuoi Approfondire?