Post by casanmanerPost by x***@gmail.com...> Per quello che so io, anche creando una funzione che restituisca direttamente una matrice di valori, poi la convalida non restituirebbe l'elenco.
Post by casanmanerAlla fine occorrerebbe sempre riportare in un intervallo di celle la matrice di valori e far puntare la convalida a quell'intervallo.
Quindi, soluzione, colonna d'appoggio.
Ciao paoloard
Se proprio non si volesse la colonna d'appoggio si potrebbe inserire, tramite VBA, l'elenco delle voci (es. verde;giallo;rosso) all'interno del campo origine dell'elenco.
Occorrerebbe sfruttare l'evento worksheetchange in modo che nel caso vengano inserite nuove voci, venga creata una nuova lista di voci uniche e riscrivendo la convalida di quella cella o intervallo di celle.
Propongo un esempio di quello che intendevo.
Nel modulo VBA del Foglio1:
'---
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo VbaError
With Target.Cells(1, 1)
If .Column = 1 And .Row >= 2 Then
Call ImpostaConvalide
End If
End With
ResumeVbaError:
Application.EnableEvents = True
Exit Sub
VbaError:
MsgBox "Errore " & Err.Number & vbCrLf & _
Err.Description, vbCritical, "VBA Error"
Resume ResumeVbaError
End Sub
'---
Nel modulo standard Modulo2:
'---
Option Explicit
Sub ImpostaConvalide()
Dim Twb As Workbook
Const sWsOrigineDati As String = "Foglio1"
Const sFrngOD As String = "A1"
Const sWsConvalide As String = "Foglio1"
Const sRngConvalide As String = "C2"
Dim rngOD As Range
Dim arrListaUnica As Variant
Dim strListaUnica As String
Dim rngConvalide As Range
Set Twb = ThisWorkbook
With Twb
With .Worksheets(sWsOrigineDati)
Set rngOD = GetRange(.Range(sFrngOD), True)
End With
End With
If Not rngOD Is Nothing Then
arrListaUnica = ListaUnicaOrdinataArray(rngOD)
strListaUnica = Join(arrListaUnica, ",")
End If
With Twb
With .Worksheets(sWsConvalide)
Set rngConvalide = .Range(sRngConvalide)
With rngConvalide
With .Validation
.Delete
If strListaUnica <> "" Then
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=strListaUnica
Else
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=" "
End If
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = "Voce non amessa!"
.InputMessage = ""
.ErrorMessage = "Inserire una voce dall'elenco a discesa presente nella cella!"
.ShowInput = False
.ShowError = True
End With
End With
End With
End With
End Sub
Function ListaUnicaOrdinataArray(IntervalloCelle As Range) As Variant
Dim i As Variant
Dim arr1 As Variant
Dim arr2() As Variant
Dim NumRow As Long
Dim oSortedArrayList As Object
Dim str As String
arr1 = IntervalloCelle.Value
NumRow = IntervalloCelle.Rows.Count
ReDim arr2(1 To NumRow)
Set oSortedArrayList = CreateObject("System.Collections.ArrayList")
If NumRow = 1 Then
arr2(1) = arr1
Else
For i = 1 To NumRow
arr2(i) = arr1(i, 1)
Next i
End If
With oSortedArrayList
For Each i In arr2
If i <> vbNullString Then
str = i
If Not .contains(str) Then .Add str
End If
Next
.Sort
ListaUnicaOrdinataArray = .ToArray
End With
End Function
'========================
Function GetRange(PrimaCellaDati As Range, _
Optional bRigaIntestazioni As Boolean = True, _
Optional bColonnaIntestazioni As Boolean = False, _
Optional sPassword As String = "") As Range
'funzione che imposta un intervallo di celle in base alla
'prima cella dell'intervallo passata nell'argomento "PrimaCellaDati"
'bRigaIntestazioni se True, valore predefinito, imposta la prima riga
'come intestazioni di colonna e assume come intervallo dati i dati a
'partire dalla riga successiva
'bColonnaIntestazioni se True, valore predifinito False, imposta la prima
'colonna come intestazioni di riga e assucem come intervanno dati i dati a
'partire dalla colonna successiva
'se il foglio è protetto da una pw inserire come argomento sPassword la
'la passoword di protezione del foglio
Dim Ws As Worksheet
Dim bProtected As Boolean
Dim OffsetRiga As Long, OffsetColonna As Long
Dim ResizeRighe As Long, ResizeColonne As Long
Set Ws = PrimaCellaDati.Parent
With Ws
bProtected = .ProtectContents
If bProtected Then .Unprotect Password:=sPassword
End With
With PrimaCellaDati
If bRigaIntestazioni Then OffsetRiga = 1
If bColonnaIntestazioni Then OffsetColonna = 1
With .CurrentRegion
ResizeRighe = .CurrentRegion.Rows.Count - OffsetRiga
ResizeColonne = .CurrentRegion.Columns.Count - OffsetColonna
End With
On Error Resume Next
Set GetRange = .Resize(ResizeRighe, ResizeColonne).Offset(OffsetRiga, OffsetColonna)
On Error GoTo 0
End With
If bProtected Then Ws.Protect Password:=sPassword ', UserInterfaceOnly:=False
End Function
'---
In Foglio1 se si aggiunge o elimina una voce sotto l'intestazione "Elenco Voci" la convalida presente in C1 viene aggiornata.
Nel caso non ci fossero voci la convalida conterrà uno "spazio" non consentendo l'inserimento di alcun valore fino a che non venga inserito un valore in colonna 1 andandosi a popolare l'elenco della convalida.
Questo il file di esempio:
https://www.dropbox.com/s/fd80kd3rqfi7qgu/Elenco%20di%20convalida%20dati%20da%20colonna%20con%20contenuto%20univoco.xlsm?dl=0