CREARE LISTA A SCORRIMENTO

Question

Buon pomeriggio ho un dubbio sulla fattibilità di un automatismo per aiutarmi col lavoro.
Spiego brevemente:
Ho una lista di 20 persone che sono numerati da 1 a 20. Il primo della lista una volta svolto il lavoro dovrebbe diventare dal numero 1 il numero 20, automaticamente gli altri salirebbero di posizione finchè non hanno a loro volta svolto il lavoro e ri essere come ultimo facendo scorrere di una posizione tutti gli altri e cosi via ciclicamente. E' possibile creare una cosa simile? Una sorta di griglia di scorrimento a turno per gli impiegati

ESEMPIO:
Andrea oggi lavora e sarà in cima alla lista. Appena Andrea ha finito il lavoro mettiamo una X accanto al suo nome e scorre in fondo alla lista facendo salire gli altri di posizione. Domani il primo sarà Francesco, ma lavorerà con Franco, Alberto ed Ugo (in ordine il 1mo, 2ndo e 3rzo) i quali a fine giornata avranno a loro volta una X accanto ai loro nomi, e l'applicativo li farà scorrere come 18,19 e 20esimi facendo salire di 3 gli altri dopo di loro e cosi via...

Spero di essere stato chiaro. Grazie a chi aiuterà!

Answer 1

Ciao Gianfranco,

ciao

Norman

ho idea che la colonna A non debba essere toccata

(forse sbaglio)

Il primo della lista una volta svolto il lavoro dovrebbe diventare dal numero 1 il numero 20

Franco, Alberto ed Ugo (in ordine il 1mo, 2ndo e 3rzo) i quali a fine giornata avranno a loro volta una X accanto ai loro nomi, e l'applicativo li farà scorrere come 18,19 e 20esimi

Credo che tu abbia ragione.

Pertanto, il codice nel modulo di codice del foglio diventa:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, Rng2 As Range, Rng3 As Range 

Const sIntervallo As String = "A1:C21" 

Set Rng = Me.Range(sIntervallo) 

Set Rng2 = Intersect(Rng.Columns(3), Target) 

If UCase(Rng2.Cells(1).Value) = "X" Then 

    On Error Resume Next 

    Set Rng3 = Rng.Columns(3).SpecialCells(xlBlanks) 

    On Error GoTo 0 

    If Not Rng3 Is Nothing Then 

        Application.EnableEvents = False 

        Rng3.Value = "a" 

        Call SortData(Me, Rng.Offset(, 1).Resize(, 2)) 

     End If 

     With Rng.Columns(3) 

     .Offset(1).Resize(.Rows.Count - 1).ClearContents 

     End With 

      Application.EnableEvents = True 

End If 

End Sub

'<<========

Mentre il codice nel modulo standard diventerebbe:

'========>>

Option Explicit

'-------->>

Public Sub SortData(SH As Worksheet, Rng As Range)

With SH.Sort 

    With .SortFields 

        .Clear 

        .Add2 Key:=Rng.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 

    End With 

    .SetRange Rng 

    .Header = xlYes 

    .MatchCase = False 

    .Orientation = xlTopToBottom 

    .SortMethod = xlPinYin 

    .Apply 

End With 

End Sub

'<<========

Ho aggiornato il mio file di prova Stefano20220419.xlsm

===

Regards,

Norman

Answer 2

ciao

Norman

ho idea che la colonna A non debba essere toccata

(forse sbaglio)

Il primo della lista una volta svolto il lavoro dovrebbe diventare dal numero 1 il numero 20

Franco, Alberto ed Ugo (in ordine il 1mo, 2ndo e 3rzo) i quali a fine giornata avranno a loro volta una X accanto ai loro nomi, e l'applicativo li farà scorrere come 18,19 e 20esimi

Answer 3

Ciao Stefano,

Avrei douto aggiungere che, a causa di un problema con l'attuale editor del forum, che inserisce righe vuote indesiderate nel codice copiato dal forum, suggerirei di copiare il mio codice direttamente dal mio file di prova.

Vorrei anche cogliere l'occasione per avvisarti che ho modificato la mia risposta precedente per apportare due piccole modifiche al mio codice originale e ho aggiornato il mio file di prova Stefano20220419.xlsm

===

Regards,

Norman

Answer 4

Ciao Stefano,

Buon pomeriggio ho un dubbio sulla fattibilità di un automatismo per aiutarmi col lavoro.
Spiego brevemente:
Ho una lista di 20 persone che sono numerati da 1 a 20. Il primo della lista una volta svolto il lavoro dovrebbe diventare dal numero 1 il numero 20, automaticamente gli altri salirebbero di posizione finchè non hanno a loro volta svolto il lavoro e ri essere come ultimo facendo scorrere di una posizione tutti gli altri e cosi via ciclicamente. E' possibile creare una cosa simile? Una sorta di griglia di scorrimento a turno per gli impiegati

ESEMPIO:
Andrea oggi lavora e sarà in cima alla lista. Appena Andrea ha finito il lavoro mettiamo una X accanto al suo nome e scorre in fondo alla lista facendo salire gli altri di posizione. Domani il primo sarà Francesco, ma lavorerà con Franco, Alberto ed Ugo (in ordine il 1mo, 2ndo e 3rzo) i quali a fine giornata avranno a loro volta una X accanto ai loro nomi, e l'applicativo li farà scorrere come 18,19 e 20esimi facendo salire di 3 gli altri dopo di loro e cosi via...

Spero di essere stato chiaro. Grazie a chi aiuterà!

Prova qualcosa del genere:

• Fai clic dx sulla linguetta del foglio di interesse
• Seleziona l'opzione Visualizza Codice dal **** menu contestuale risultante
• Incolla il seguente codice:

 '========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, Rng2 As Range, Rng3 As Range 

Const sIntervallo As String = "**A1:C21**"                      **'<<=== Modifica**

Set Rng = Me.Range(sIntervallo) 

Set Rng2 = Intersect(Rng.Columns(3), Target) 

If UCase(Rng2.Cells(1).Value) = "X" Then 

    On Error Resume Next 

    Set Rng3 = Rng.Columns(3).SpecialCells(xlBlanks) 

    On Error GoTo 0 

    If Not Rng3 Is Nothing Then 

        Application.EnableEvents = False 

        Rng3.Value = "a" 

        Call SortData(Me, Rng) 

     End If 

     With Rng.Columns(3) 

     .Offset(1).Resize(.Rows.Count - 1).ClearContents 

     End With 

      Application.EnableEvents = True 

End If 

End Sub

'<<========

• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'========>>

Option Explicit

'-------->>

Public Sub SortData(SH As Worksheet, Rng As Range)

With SH.Sort 

    With .SortFields 

        .Clear 

        .Add2 Key:=Rng.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 

    End With 

    .SetRange Rng 

    .Header = xlYes 

    .MatchCase = False 

    .Orientation = xlTopToBottom 

    .SortMethod = xlPinYin 

    .Apply 

End With 

End Sub

'<<========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel.
• Salva il file con l'estensione xlsm

Potresti scaricare il mio file di prova Stefano20220419.xlsm

===

Regards,

Norman