Riempire range variabile con tre valori fissi ma in ordine variabile

Question

Scusate il titolo un pò contorto, ma non mi è venuto niente di meglio; cortesemente mi servirebbe una mano per creare una macro.

Devo riempire un range variabile (colonna C e partendo dalla riga 6), con tre valori in ordine e partendo da uno di questi valori che può variare e fermarmi quando alla colonna A la relativa cella è vuota.

in pratica io metto:

in G2 il Valore1

In G3 il Valore2

in G4 il Valore3

in F2 il valore da cui iniziare (che appunto può variare fra uno dei tre di cui sopra), quindi se in C6 inizia con Valore2, a seguire dovrò avere Valore3 e Valore1; oppore se in C6 inizia con Valore3, a seguire dovrò avere Valore1 e Valore2; eccetera...

e partendo dalla riga 6 colonna C mi deve riempire tutte le celle fino a che alla colonna A la cella è vuota (alla colonna A non ci sono celle vuote fra la riga 6 e l'ultima che è variabile)

Spero di essermi spiegato.

Grazie mille e una buona giornata a tutti.

Ciao Antonio

Answer 1

Devo riempire un range variabile (colonna C e partendo dalla riga 6), con tre valori in ordine e partendo da uno di questi valori che può variare e fermarmi quando alla colonna A la relativa cella è vuota.

in pratica io metto:

in G2 il Valore1

In G3 il Valore2

in G4 il Valore3

in F2 il valore da cui iniziare (che appunto può variare fra uno dei tre di cui sopra), quindi se in C6 inizia con Valore2, a seguire dovrò avere Valore3 e Valore1; oppore se in C6 inizia con Valore3, a seguire dovrò avere Valore1 e Valore2; eccetera...

e partendo dalla riga 6 colonna C mi deve riempire tutte le celle fino a che alla colonna A la cella è vuota (alla colonna A non ci sono celle vuote fra la riga 6 e l'ultima che è variabile)

Ciao Antonio.

Se ho ben compreso, un modo potrebbe essere il seguente:

' Modulo1

'

Option Explicit

Public Sub Macro1()

On Error GoTo ErrH

Const ShName = "Foglio1"

Const RngIdxName = "A6"

Const RngInpName = "F2"

Const RngOutName = "C6"

Const RngValName = "G2:G4"

Dim wbk     As Excel.Workbook

Dim sh      As Excel.Worksheet

Dim rngIdx  As Excel.Range

Dim rngInp  As Excel.Range

Dim rngOut  As Excel.Range

Dim rngVal  As Excel.Range

Dim lngIdx  As Long

Dim lngCnt  As Long

    Set wbk = ThisWorkbook

    Set sh = wbk.Worksheets(ShName)

    With sh

      Set rngIdx = .Range(RngIdxName)

      Set rngInp = .Range(RngInpName)

      Set rngOut = .Range(RngOutName)

      Set rngVal = .Range(RngValName)

    End With

    On Error Resume Next

    '=CONFRONTA(F2;G2:G4;0)

    lngIdx = WorksheetFunction.Match(rngInp, rngVal, 0)

    On Error GoTo ErrH

    If lngIdx Then

      lngCnt = lngIdx - 1

      Do Until IsEmpty(rngIdx.Value)

        rngOut.Value = rngVal((lngCnt Mod 3) + 1).Value

        lngCnt = lngCnt + 1

        Set rngOut = rngOut.Offset(1)

        Set rngIdx = rngIdx.Offset(1)

      Loop

    Else

      Do Until IsEmpty(rngIdx.Value)

        rngOut.Value = Empty

        Set rngOut = rngOut.Offset(1)

        Set rngIdx = rngIdx.Offset(1)

      Loop

    End If

ExitProc:

    Set rngVal = Nothing

    Set rngOut = Nothing

    Set rngInp = Nothing

    Set rngIdx = Nothing

    Set sh = Nothing

    Set wbk = Nothing

    Exit Sub

ErrH:

    MsgBox Err.Description

    Resume ExitProc

End Sub

--

Ciao!

Maurizio

Answer 2

Ciao Maurizio; ho provato il codice e funziona benissimo; ora me lo studio e vediamo se riesco acapirci qualcosa :-)) ... io mi ero arenato ... 

Grazie infinite e buona giornata.

Grazie a te Antonio del riscontro.

Per chiarimenti… Siamo tutti qua. :)

--

Ciao!

Maurizio

Answer 3

Ciao Maurizio; ho provato il codice e funziona benissimo; ora me lo studio e vediamo se riesco acapirci qualcosa :-)) ... io mi ero arenato ...

Grazie infinite e buona giornata.