Estensione della regola di convalida di una cella che precede quando si seleziona una cella che non ne é sprovvista

Question

Buongiorno a tutti.

Desidererei sapere se esiste la possibilita, con codice VBA, di estendere la regola di convalida di una cella precedente ad una cella che ne è sprovvista.

Esempio:

foglio1, celle A1:A100 hanno la regola di convalida, selezionando la cella A101 (cliccando col mouse o posizionandocisi tramite le frecce direzionali) questa deve ricevere le stesse regole della cella che la precede (la A100); la stessa cosa per tutte le celle che seguono (A102, A103 ... A(n)).

Vi ringrazio anticipatamente.

Paolo

Answer 1

Ciao Paolo,

grazie ancora per la tua risposta, ma prima di chiedere definitivamente questo thread, visto che non sono capace a modificare autonomamente il codice che mi hai suggerito, volevo ancora sapere se era possibile modificarlo in modo che si potesse ottenere lo stesso risultato su più colonne anche non vicine, dello stesso foglio.

Tu chiedi .... io obbedisco!  :-)

Prova la seguente versione che estende la convalida dati alla prossima cella se la convalida sia presente nella cella precedente, independentemente della colonna in cui si trova. Nota che la convalida applicata alla nuova cella sarà sempre quella della cella precedente. Inoltre, questa versione permette anche che ci siano più intervalli/tipi di convalida dati nella stessa colonna.

'=========>>

Option Explicit

'--------->>

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim RngConvalida As Range

    Dim primaRiga As Long

    Dim bValidation As Boolean

    On Error GoTo XIT

    If Target.Cells.Count > 1 Then

        Exit Sub

    End If

    Application.EnableEvents = False

    On Error Resume Next

    bValidation = Not Intersect(Me.UsedRange.SpecialCells( _

                                xlCellTypeAllValidation), Target) Is Nothing

    On Error GoTo XIT

    If bValidation Then

        '\ La convalida dati è già presente nella cella selezionata:

        '\ non sovrascriverla!

        GoTo XIT

    End If

    Set RngConvalida = Intersect(Me.UsedRange.SpecialCells( _

                                 xlCellTypeAllValidation), Target.Offset(-1))

    If Not RngConvalida Is Nothing Then

        RngConvalida.Copy

        Target.PasteSpecial xlPasteValidation

        Application.CutCopyMode = False

    End If

XIT:

    Application.EnableEvents = True

End Sub

'<<=========

===

Regards,

Norman

Answer 2

Ciao Paolo,

Ti ringrazio per il cortese riscontro.

Per chiudere questo thread, ti chiederei gentilmente di segnare la mia risposta come Risposta. In questo modo, tu aiuterai anche coloro che potessero cercare una soluzione ai problemi simili negli archivi della comunità.

===

Regards,

Norman

Answer 3

Funziona benissimo!

Posso chiedere ancore se è possibile modificare il codice affinchè funzioni su più colonne dello stesso foglio, magari non consecutive?

Grazie mille!

Answer 4

Ciao Paolo,

Desidererei sapere se esiste la possibilita, con codice VBA, di estendere la regola di convalida di una cella precedente ad una cella che ne è sprovvista.

Esempio:

foglio1, celle A1:A100 hanno la regola di convalida, selezionando la cella A101 (cliccando col mouse o posizionandocisi tramite le frecce direzionali) questa deve ricevere le stesse regole della cella che la precede (la A100); la stessa cosa per tutte le celle che seguono (A102, A103 ... A(n)).

Prova qualcosa del genere:

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

'=========>>

Option Explicit

'--------->>

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Rng As Range, RngConvalida As Range, rCell As Range

    Dim primaRiga As Long

    Const colonnaConvalida As String = "A"         '<<=== Modifica

    Set Rng = Me.Columns(colonnaConvalida)

    On Error GoTo XIT

    Application.EnableEvents = False

    Set RngConvalida = Rng.SpecialCells(xlCellTypeAllValidation)

    If Not RngConvalida Is Nothing Then

        With RngConvalida

            Set rCell = .Cells(.Cells.Count).Offset(1)

        End With

    Else

        Exit Sub

    End If

    If Not Intersect(Target, rCell) Is Nothing Then

        With rCell

            .Offset(-1).Copy

            .PasteSpecial xlPasteValidation

            Application.CutCopyMode = False

        End With

    End If

XIT:

    Application.EnableEvents = True

End Sub

'<<========= 

• Alt-Q per chiudere l'editor di VBA e tornare a Excel.

===

Regards,

Norman