Macro abbastanza lenta in esecuzione.

Question

Ciao,

per aumentare di 1 il valore inserito nell'intervallo di celle O4:Q4,S4:AY4:

uso la seguente macro:

Sub Pul_Aumenta_Click()

    Dim Rng As Range, rCell As Range

    Const sIntervallo As String = "O4:Q4,S4:AY4"

    Set Rng = Range(sIntervallo)

    On Error Resume Next

    For Each rCell In Rng.Cells

        rCell = rCell + 1

    Next rCell

    Rng.Value = rCell

End Sub

Però l'aggiornamento dati non è immediato, nel senso che vedo muoversi, naturalmente in maniera abbastanza veloce, l'aggiornamento delle celle.

Siccome l'intervallo di celle è corto e tra l'altro formato da una sola riga, secondo voi il codice, anche se funzionante, ha qualche problema?

Vladimiro

Answer 1

Prova questo, ho modificato un po di codice, se non capisci dimmi pure

https://1drv.ms/x/s!AmEDljrOgi7E_TYDI690OXWoxtE...

Answer 2

Perche' e' diverso il modo in cui le celle vengono formattate.

Nel tuo codice prima crei un array, lo riempi con tutti i dati esistenti e poi lo reinserisci e quindi per ogni valore reinserito viene richiamata la funzione Worksheet_change

Praticamente fai n volte le stesse operazioni dove n e' il numero di elementi reinseriti. Hai pensato male a come implementare la funzione e io ho provato a riscrivertela dato che chiedevi di velocizzarla questo e' uno dei modi per farlo.

Nel codice che ti ho messo, semplicemente mette il valore prendendo la cella libera più a destra rispetto a quella riga e questo worksheet_change lo formatta

Facendo una volta l'operazione.

Se le celle sono piene fa un semplice copia e incolla dei valori partendo dal secondo. Se puoi spostare perché riscrivere tutto ogni volta? Lo stesso vale per la riga di appoggio in alto, che ha i valori + 1, ti evita il ciclo delle celle, di nuovo, se puoi spostare perché ciclare?

Answer 3

Prova questo, ho modificato un po di codice, se non capisci dimmi pure

https://1drv.ms/x/s!AmEDljrOgi7E_TYDI690OXWoxtE...

Ciao Daniele,

naturalmente funziona! :-)

Però, a questo punto, il nuovo codice diventa un problema per me, visto che il programma è solo all'inizio.

Ci sono molti riferimenti nuovi che non ho mai usato e che dovrò sicuramente riadattare o magari sostituire in vista di uno scenario più complesso e se non me li studio per bene, sarà complicato andare avanti.

Detto ciò e ringraziandoti per questo nuovo input che mia hai dato, mi spieghi perché, modificando nel mio file solo questa parte di codice le celle non vengono formattate?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Rossi As Variant

    Dim Neri As Variant

    Rossi = Array(1, 3, 5, 7, 9, 12, 14, 16, 18, 19, 21, 23, 25, 27, 30, 32, 34, 36)

    Neri = Array(2, 4, 6, 8, 10, 11, 13, 15, 17, 20, 22, 24, 26, 28, 29, 31, 33, 35)

    Const sIntervallo_Progressivo As String = "O6:AY7"

    If Target.Count = 1 And Not Intersect(Target, Range(sIntervallo_Progressivo)) Is Nothing Then

        If IsNumeric(Application.Match(Target.Value, Rossi, 0)) Then

            Target.Interior.Color = vbRed

        ElseIf IsNumeric(Application.Match(Target.Value, Neri, 0)) Then

            Target.Interior.Color = vbBlack

        ElseIf Target.Value = "0" Then

            Target.Interior.Color = RGB(11, 137, 98)

        End If

    End If

End Sub

Vladimiro

Answer 4

Ciao Vladimiro,

bentrovato nella community Microsoft, piacere di aiutarti, sono Daniele un consulente indipendente,

prova con

Sub Pul_Aumenta_Click()
    Dim Rng As Range, rCell As Range
    Const sIntervallo As String = "O4:Q4,S4:AY4"
    Set Rng = Range(sIntervallo)

    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each rCell In Rng.Cells
        rCell = rCell + 1
    Next rCell
    Rng.Value = rCell
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

Inoltre piuttosto che On Error Resume Next, farei prima un controllo se sia un numero o un campo vuoto, controllare gli errori a runtime puo essere dispendioso.

Ad ogni modo non dovrebbe essere lenta un'operazione cosi semplice, probabilmente il tuo foglio fa calcoli con quei dati e la disabilitazione del calcolo automatico dovrebbe velocizzarla.

Ciao Daniele,

non cambia nulla e il motivo è molto semplice: il codice incriminato è quest'altro:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngProgressivo As Range

    Dim i As Long

    Dim j As Integer

    Dim Rossi(18) As Integer

    Dim Neri(18) As Integer

    Rossi(1) = 1

    Rossi(2) = 3

    Rossi(3) = 5

    Rossi(4) = 7

    Rossi(5) = 9

    Rossi(6) = 12

    Rossi(7) = 14

    Rossi(8) = 16

    Rossi(9) = 18

    Rossi(10) = 19

    Rossi(11) = 21

    Rossi(12) = 23

    Rossi(13) = 25

    Rossi(14) = 27

    Rossi(15) = 30

    Rossi(16) = 32

    Rossi(17) = 34

    Rossi(18) = 36

    Neri(1) = 2

    Neri(2) = 4

    Neri(3) = 6

    Neri(4) = 8

    Neri(5) = 10

    Neri(6) = 11

    Neri(7) = 13

    Neri(8) = 15

    Neri(9) = 17

    Neri(10) = 20

    Neri(11) = 22

    Neri(12) = 24

    Neri(13) = 26

    Neri(14) = 28

    Neri(15) = 29

    Neri(16) = 31

    Neri(17) = 33

    Neri(18) = 35

    Const sIntervallo_Progressivo As String = "O6:AY7"

    With Me

        Set rngProgressivo = .Range(sIntervallo_Progressivo)

    End With

    With rngProgressivo

        For i = 1 To .Cells.Count

            For j = 1 To 18

                If .Cells(i).Value = Rossi(j) Then

                    rngProgressivo.Cells(i).Interior.Color = vbRed

                    Exit For

                ElseIf .Cells(i).Value = Neri(j) Then

                    rngProgressivo.Cells(i).Interior.Color = vbBlack

                    Exit For

                ElseIf .Cells(i).Value = "0" Then

                    rngProgressivo.Cells(i).Interior.Color = RGB(11, 137, 98)

                    Exit For

                End If

            Next j

        Next i

    End With

End Sub

Qui puoi trovare il file in costruzione, vedi se c'è qualcosa che non va nel suddetto codice.

Vladimiro

Answer 5

Ciao Vladimiro,

bentrovato nella community Microsoft, piacere di aiutarti, sono Daniele un consulente indipendente,

prova con

Sub Pul_Aumenta_Click()
    Dim Rng As Range, rCell As Range
    Const sIntervallo As String = "O4:Q4,S4:AY4"
    Set Rng = Range(sIntervallo)

    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each rCell In Rng.Cells
        rCell = rCell + 1
    Next rCell
    Rng.Value = rCell
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

Inoltre piuttosto che On Error Resume Next, farei prima un controllo se sia un numero o un campo vuoto, controllare gli errori a runtime puo essere dispendioso.

Ad ogni modo non dovrebbe essere lenta un'operazione cosi semplice, probabilmente il tuo foglio fa calcoli con quei dati e la disabilitazione del calcolo automatico dovrebbe velocizzarla.