Fare la stessa iterazione su più celle contemporaneamente

Question

Salve vorrei creare una macro per eseguire una stessa iterazione su più celle contemporaneamente. L'iterazione deve essere eseguita ponendo il valore su una cella (ad esempio cella A1) per poi essere impiegato in operazioni presenti in altre celle (ad esempio nelle celle A2,A3,A4). Tali operazioni permettono di calcolare il valore che deve essere paragonato con quello inserito in A1 e che ovviamente è contenuto in un'altra cella (ad esempio cella A5). L'iterazione deve terminare quando la differenza tra il valore inserito e quello calcolato sia in valore assoluto uguale a 0.001. Gli incrementi ad ogni singolo ciclo devono essere pari a 0.001.

Riporto di seguito il codice fatto per l'iterazione su una singola cella:

Dim xValM As Double

    Dim xValL As Double

    Dim xValN As Double

    Dim xVal As Double

    xVal = 0.001

    Sheets("SOIL PARAMETERS").Select

    xValM = Range("D685")

    xValL = Range("K685")

    Do

        If Abs(xValM - xValL) < 0.001 Then

            GoTo fine

        End If

        Range("D685") = Range("D685") + xVal

        xValM = Range("D685")

        xValL = Range("K685")

    Loop Until Abs(xValM - xValL) = 0.001

fine:

End Sub

Il codice funziona ma lo vorrei fare contemporaneamente per tutte le celle che vanno da 585 a 885.

Come dovrei fare?

Answer 1

Non ho capito.

Quando la differenza è pari a 0.001, cosa deve accadere?

Oppure, capisco bene che alla fine fra le celle di D e K della stessa riga deve esserci una differenza pari a 0.001?

Se la mia seconda ipotesi è corretta:

Public Sub m()

    Dim sh As Worksheet

    Const VALORE As Double = 0.001

    Dim lng As Long

    Set sh = ThisWorkbook.Worksheets("SOIL PARAMETERS")

    With sh

        For lng = 585 To 885

            .Range("K" & lng).Value = Abs(.Range("D" & lng).Value - VALORE)

        Next

    End With

    Set sh = Nothing

End Sub

Controlla perché non ho capito se è K che deve avere alla fine un valore assoluto pari a D - 0.001